diff --git a/UnitConfig.dcu b/UnitConfig.dcu index a10affd..46fd33b 100644 Binary files a/UnitConfig.dcu and b/UnitConfig.dcu differ diff --git a/UnitConfig.dfm b/UnitConfig.dfm index 70647c7..320ebb8 100644 --- a/UnitConfig.dfm +++ b/UnitConfig.dfm @@ -2,7 +2,7 @@ object FormConfig: TFormConfig Left = 316 Top = 238 Width = 598 - Height = 340 + Height = 382 Caption = 'Configuration g'#233'n'#233'rale' Color = clBtnFace Font.Charset = DEFAULT_CHARSET @@ -16,7 +16,7 @@ object FormConfig: TFormConfig TextHeight = 13 object Label6: TLabel Left = 128 - Top = 248 + Top = 288 Width = 332 Height = 13 Caption = @@ -41,7 +41,7 @@ object FormConfig: TFormConfig Left = 8 Top = 8 Width = 265 - Height = 89 + Height = 81 Caption = 'CDM Rail' TabOrder = 0 object Label1: TLabel @@ -151,7 +151,7 @@ object FormConfig: TFormConfig end object Button1: TButton Left = 112 - Top = 272 + Top = 312 Width = 105 Height = 25 Caption = 'Appliquer et Fermer' @@ -160,7 +160,7 @@ object FormConfig: TFormConfig end object GroupBox3: TGroupBox Left = 8 - Top = 104 + Top = 96 Width = 265 Height = 105 Caption = 'Acc'#232's r'#233'seau '#224' l'#39'interface vers la centrale LENZ' @@ -246,11 +246,35 @@ object FormConfig: TFormConfig end object Button2: TButton Left = 352 - Top = 272 + Top = 312 Width = 113 Height = 25 Caption = 'Fermer sans appliquer' TabOrder = 5 OnClick = Button2Click end + object GroupBox5: TGroupBox + Left = 8 + Top = 208 + Width = 265 + Height = 57 + Caption = 'Versions du programme' + TabOrder = 6 + object CheckVerifVersion: TCheckBox + Left = 8 + Top = 16 + Width = 249 + Height = 17 + Caption = 'V'#233'rifications de nouvelle version au d'#233'marrage' + TabOrder = 0 + end + object CheckInfoVersion: TCheckBox + Left = 8 + Top = 32 + Width = 241 + Height = 17 + Caption = 'Information sur la version actuelle' + TabOrder = 1 + end + end end diff --git a/UnitConfig.pas b/UnitConfig.pas index 8bab1df..cd19fa0 100644 --- a/UnitConfig.pas +++ b/UnitConfig.pas @@ -4,7 +4,7 @@ interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, - Dialogs, ExtCtrls, StdCtrls ; + Dialogs, ExtCtrls, StdCtrls , verif_version ; type TFormConfig = class(TForm) @@ -37,6 +37,9 @@ type Label10: TLabel; Label11: TLabel; Label12: TLabel; + GroupBox5: TGroupBox; + CheckVerifVersion: TCheckBox; + CheckInfoVersion: TCheckBox; procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure FormActivate(Sender: TObject); @@ -260,15 +263,15 @@ begin if changeInterface then begin if AdresseIP<>'0' then + begin + Affiche('demande connexion à la centrale Lenz par Ethernet',clyellow); + With Formprinc do begin - Affiche('demande connexion à la centrale Lenz par Ethernet',clyellow); - With Formprinc do - begin - ClientSocketLenz.port:=port; - ClientSocketLenz.Address:=AdresseIP; - ClientSocketLenz.Open; - end; - end + ClientSocketLenz.port:=port; + ClientSocketLenz.Address:=AdresseIP; + ClientSocketLenz.Open; + end; + end end; if changeUSB then @@ -276,6 +279,9 @@ begin deconnecte_USB; connecte_USB; end; + + verifVersion:=CheckVerifVersion.Checked; + notificationVersion:=CheckInfoVersion.Checked; formConfig.close; end; @@ -305,6 +311,10 @@ begin if Valeur_entete=0 then RadioButton1.checked:=true; if Valeur_entete=1 then RadioButton2.checked:=true; if Valeur_entete=2 then RadioButton3.checked:=true; + + CheckVerifVersion.Checked:=verifVersion; + CheckInfoVersion.Checked:=notificationVersion; + end; end. diff --git a/UnitConfigTCO.dcu b/UnitConfigTCO.dcu index b8f2818..9434d77 100644 Binary files a/UnitConfigTCO.dcu and b/UnitConfigTCO.dcu differ diff --git a/UnitConfigTCO.dfm b/UnitConfigTCO.dfm index 9314153..e52c26b 100644 --- a/UnitConfigTCO.dfm +++ b/UnitConfigTCO.dfm @@ -1,7 +1,7 @@ object FormConfigTCO: TFormConfigTCO Left = 542 Top = 389 - Width = 405 + Width = 360 Height = 251 Caption = 'Configuration du TCO' Color = clBtnFace @@ -11,7 +11,7 @@ object FormConfigTCO: TFormConfigTCO Font.Name = 'MS Sans Serif' Font.Style = [] OldCreateOrder = False - OnCreate = FormCreate + OnActivate = FormActivate PixelsPerInch = 96 TextHeight = 13 object Label1: TLabel @@ -42,34 +42,14 @@ object FormConfigTCO: TFormConfigTCO Height = 13 Caption = 'Nombre de cellules en vertical:' end - object LabelNbCellX: TLabel - Left = 192 - Top = 52 - Width = 96 - Height = 20 - Caption = 'LabelNbCellX' - Font.Charset = DEFAULT_CHARSET - Font.Color = clWindowText - Font.Height = -16 - Font.Name = 'MS Sans Serif' - Font.Style = [] - ParentFont = False - end - object LabelNbCellY: TLabel - Left = 192 - Top = 76 - Width = 96 - Height = 20 - Caption = 'LabelNbCellX' - Font.Charset = DEFAULT_CHARSET - Font.Color = clWindowText - Font.Height = -16 - Font.Name = 'MS Sans Serif' - Font.Style = [] - ParentFont = False + object LabelErreur: TLabel + Left = 35 + Top = 144 + Width = 3 + Height = 13 end object ButtonOK: TButton - Left = 168 + Left = 240 Top = 176 Width = 75 Height = 25 @@ -110,4 +90,20 @@ object FormConfigTCO: TFormConfigTCO Caption = 'dessine grille' TabOrder = 4 end + object EditNbCellX: TEdit + Left = 184 + Top = 56 + Width = 49 + Height = 21 + TabOrder = 5 + Text = 'EditNbCellX' + end + object EditNbCellY: TEdit + Left = 184 + Top = 80 + Width = 49 + Height = 21 + TabOrder = 6 + Text = 'EditNbCellY' + end end diff --git a/UnitConfigTCO.pas b/UnitConfigTCO.pas index 506c3e8..46488d6 100644 --- a/UnitConfigTCO.pas +++ b/UnitConfigTCO.pas @@ -15,13 +15,14 @@ type Label2: TLabel; Label3: TLabel; Label4: TLabel; - LabelNbCellX: TLabel; - LabelNbCellY: TLabel; ButtonDessine: TButton; CheckDessineGrille: TCheckBox; + EditNbCellX: TEdit; + EditNbCellY: TEdit; + LabelErreur: TLabel; procedure ButtonOKClick(Sender: TObject); - procedure FormCreate(Sender: TObject); procedure ButtonDessineClick(Sender: TObject); + procedure FormActivate(Sender: TObject); private { Déclarations privées } public @@ -38,50 +39,85 @@ uses UnitPrinc; {$R *.dfm} -procedure TFormConfigTCO.ButtonOKClick(Sender: TObject); -var i,erreur : integer; +function verif_config_TCO : boolean; // renvoie true si ok +var erreur : integer; + nokNbX,nokNbY,nokHt,nokLg : boolean; begin - Val(EditTailleCellX.Text,i,erreur); - LargeurCell:=i; - Val(EditTailleCellY.Text,i,erreur); - HauteurCell:=i; - with formTCO do + with formConfigTCO do begin - ImageTCO.Width:=LargeurCell*NbreCellX; - ImageTCO.Height:=HauteurCell*NbreCellY; - end; - AvecGrille:=checkDessineGrille.Checked; - formTCO.affiche_TCO; - close; -end; + Val(EditNbCellX.Text,NbreCellX,erreur); + nokNbX:=erreur<>0; + if nokNbX then LabelErreur.caption:='Erreur nombre de cellules X'; + nokNbX:=(NbreCellX<20) or (NbreCellX>MaxCellX); + if nokNbX then LabelErreur.caption:='Erreur: nombre de cellules X: mini=20 maxi='+IntToSTR(MaxCellX); -procedure TFormConfigTCO.FormCreate(Sender: TObject); -begin - EditTailleCellX.Text:=IntToSTR(LargeurCell); - EditTailleCellY.Text:=IntToSTR(HauteurCell); - LabelNbCellX.Caption:=IntToSTR(NbreCellX); - LabelNbCellY.Caption:=IntToSTR(NbreCellY); + Val(EditNbCellY.Text,NbreCellY,erreur); + nokNbY:=erreur<>0; + if nokNbY then LabelErreur.caption:='Erreur: nombre de cellules Y'; + nokNbY:=nokNbY or (NbreCellY<10) or (NbreCellY>MaxCellY); + if nokNbY then LabelErreur.caption:='Erreur: nombre de cellules Y: mini=10 maxi='+IntToSTR(MaxCellY); + + Val(EditTailleCellX.Text,LargeurCell,erreur); + nokLg:=erreur<>0; + if nokLg then LabelErreur.caption:='Erreur largeur de cellules'; + nokLg:=nokLg or (LargeurCell<20) or (LargeurCell>50) ; + if nokLg then LabelErreur.caption:='Erreur: Tailles des cellules - largeur cellules mini=20 maxi=50'; + Val(EditTailleCellY.Text,HauteurCell,erreur); + nokHt:=erreur<>0; + if nokHt then LabelErreur.caption:='Erreur hauteur de cellules'; + nokHt:=nokHt or (HauteurCell<20) or (HauteurCell>50) ; + if nokHt then LabelErreur.caption:='Erreur: Tailles des cellules - hauteur cellules mini=20 maxi=50'; + + AvecGrille:=checkDessineGrille.Checked; + end; + verif_config_TCO:=not(nokNbX or nokNbY or nokHt or nokLg); end; - +procedure TFormConfigTCO.ButtonOKClick(Sender: TObject); +var i : integer; + +begin + if verif_config_TCO then + begin + with formTCO do + begin + ImageTCO.Width:=LargeurCell*NbreCellX; + ImageTCO.Height:=HauteurCell*NbreCellY; + end; + AvecGrille:=checkDessineGrille.Checked; + formTCO.affiche_TCO; + LabelErreur.caption:=''; + close; + end; +end; procedure TFormConfigTCO.ButtonDessineClick(Sender: TObject); var i,erreur : integer; r : Trect; c : tCanvas; begin - - Val(EditTailleCellX.Text,i,erreur); - LargeurCell:=i; - Val(EditTailleCellY.Text,i,erreur); - HauteurCell:=i; - with formTCO do + if verif_config_TCO then begin - ImageTCO.Width:=LargeurCell*NbreCellX; - ImageTCO.Height:=HauteurCell*NbreCellY; + with formTCO do + begin + ImageTCO.Width:=LargeurCell*NbreCellX; + ImageTCO.Height:=HauteurCell*NbreCellY; + end; + formTCO.affiche_TCO; end; - formTCO.affiche_TCO; +end; + + + + +procedure TFormConfigTCO.FormActivate(Sender: TObject); +begin + EditTailleCellX.Text:=IntToSTR(LargeurCell); + EditTailleCellY.Text:=IntToSTR(HauteurCell); + EditNbCellX.Text:=IntToSTR(NbreCellX); + EditNbCellY.Text:=IntToSTR(NbreCellY); + checkDessineGrille.Checked:=AvecGrille; end; end. diff --git a/UnitDebug.dcu b/UnitDebug.dcu index 3216e90..9ebeabc 100644 Binary files a/UnitDebug.dcu and b/UnitDebug.dcu differ diff --git a/UnitPilote.dcu b/UnitPilote.dcu index 51dcbdc..15832cd 100644 Binary files a/UnitPilote.dcu and b/UnitPilote.dcu differ diff --git a/UnitPrinc.dcu b/UnitPrinc.dcu index 3410554..f9f4e9b 100644 Binary files a/UnitPrinc.dcu and b/UnitPrinc.dcu differ diff --git a/UnitPrinc.dfm b/UnitPrinc.dfm index 292bec4..d8f8524 100644 --- a/UnitPrinc.dfm +++ b/UnitPrinc.dfm @@ -1,11 +1,9 @@ object FormPrinc: TFormPrinc - Left = 56 - Top = 197 - AutoSize = True - BorderStyle = bsSingle + Left = 30 + Top = 270 + Width = 1212 + Height = 664 Caption = 'Client TCP-IP CDM Rail ou USB - syst'#232'me LENZ' - ClientHeight = 606 - ClientWidth = 1196 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText @@ -15,9 +13,13 @@ object FormPrinc: TFormPrinc Menu = MainMenu1 OldCreateOrder = False Position = poScreenCenter + Scaled = False ShowHint = True OnClose = FormClose OnCreate = FormCreate + DesignSize = ( + 1196 + 606) PixelsPerInch = 96 TextHeight = 13 object LabelTitre: TLabel @@ -33,19 +35,6 @@ object FormPrinc: TFormPrinc Font.Style = [fsBold, fsItalic] ParentFont = False end - object LabelEtat: TLabel - Left = 456 - Top = 16 - Width = 152 - Height = 18 - Caption = 'Initialisations en cours' - Font.Charset = ANSI_CHARSET - Font.Color = clWindowText - Font.Height = -16 - Font.Name = 'Arial' - Font.Style = [] - ParentFont = False - end object Image9feux: TImage Left = 384 Top = 0 @@ -678,8 +667,8 @@ object FormPrinc: TFormPrinc Visible = False end object Image2feux: TImage - Left = 1096 - Top = 136 + Left = 776 + Top = 128 Width = 33 Height = 57 Picture.Data = { @@ -752,8 +741,8 @@ object FormPrinc: TFormPrinc Visible = False end object Image2Dir: TImage - Left = 968 - Top = 48 + Left = 696 + Top = 184 Width = 41 Height = 25 Picture.Data = { @@ -827,8 +816,8 @@ object FormPrinc: TFormPrinc Visible = False end object Image3Dir: TImage - Left = 1008 - Top = 48 + Left = 768 + Top = 136 Width = 49 Height = 25 Picture.Data = { @@ -905,8 +894,8 @@ object FormPrinc: TFormPrinc Visible = False end object Image4Dir: TImage - Left = 1056 - Top = 48 + Left = 816 + Top = 128 Width = 57 Height = 25 Picture.Data = { @@ -993,8 +982,8 @@ object FormPrinc: TFormPrinc Visible = False end object Image5Dir: TImage - Left = 1112 - Top = 48 + Left = 664 + Top = 120 Width = 65 Height = 25 Picture.Data = { @@ -1091,8 +1080,8 @@ object FormPrinc: TFormPrinc Visible = False end object Image6Dir: TImage - Left = 1112 - Top = 80 + Left = 808 + Top = 152 Width = 81 Height = 25 Picture.Data = { @@ -1198,41 +1187,27 @@ object FormPrinc: TFormPrinc 0000} Visible = False end - object Label1: TLabel - Left = 656 - Top = 148 - Width = 89 - Height = 13 - Caption = 'Nombre de trains : ' - end - object LabelNbTrains: TLabel - Left = 760 - Top = 144 - Width = 9 - Height = 19 - Caption = '0' + object LabelEtat: TLabel + Left = 456 + Top = 16 + Width = 152 + Height = 18 + Anchors = [akTop, akRight] + Caption = 'Initialisations en cours' Font.Charset = ANSI_CHARSET - Font.Color = clBlack + Font.Color = clWindowText Font.Height = -16 Font.Name = 'Arial' - Font.Style = [fsBold] + Font.Style = [] ParentFont = False end - object BoutVersion: TButton - Left = 1008 - Top = 16 - Width = 83 - Height = 33 - Caption = 'Dem version' - TabOrder = 0 - OnClick = BoutVersionClick - end object ListBox1: TListBox Left = 8 Top = 48 Width = 633 Height = 520 Style = lbOwnerDrawFixed + Anchors = [akLeft, akTop, akRight, akBottom] Color = clBlack Font.Charset = ANSI_CHARSET Font.Color = clBlue @@ -1241,34 +1216,31 @@ object FormPrinc: TFormPrinc Font.Style = [] ItemHeight = 16 ParentFont = False - TabOrder = 1 + TabOrder = 0 OnDrawItem = ListBox1DrawItem end - object BoutonRaf: TButton - Left = 912 - Top = 16 - Width = 89 - Height = 33 - Caption = 'Rafraichissement' - TabOrder = 2 - OnClick = BoutonRafClick - end object ScrollBox1: TScrollBox Left = 648 - Top = 168 + Top = 176 Width = 537 - Height = 405 + Height = 393 + HorzScrollBar.Smooth = True + HorzScrollBar.Tracking = True + VertScrollBar.Smooth = True + VertScrollBar.Tracking = True + Anchors = [akTop, akRight, akBottom] Color = clWhite ParentColor = False - TabOrder = 3 + TabOrder = 1 end object GroupBox1: TGroupBox - Left = 656 - Top = 8 + Left = 648 + Top = 0 Width = 249 Height = 129 + Anchors = [akTop, akRight] Caption = 'Commande d'#39'accessoires' - TabOrder = 4 + TabOrder = 2 object Label2: TLabel Left = 7 Top = 16 @@ -1309,17 +1281,6 @@ object FormPrinc: TFormPrinc Text = '1' OnEnter = EditvalEnter end - object ButtonCommande: TButton - Left = 124 - Top = 24 - Width = 109 - Height = 33 - Hint = 'Ecriture des accessoires DCC' - Caption = 'Envoi commande' - TabOrder = 2 - WordWrap = True - OnClick = ButtonCommandeClick - end object ButtonEcrCV: TButton Left = 8 Top = 64 @@ -1327,7 +1288,7 @@ object FormPrinc: TFormPrinc Height = 25 Hint = 'Ecriture CV en mode direct sur voie de programmation' Caption = 'Ecriture CV - 1 '#224' 255 par bus XpressNet' - TabOrder = 3 + TabOrder = 2 WordWrap = True OnClick = ButtonEcrCVClick end @@ -1339,28 +1300,20 @@ object FormPrinc: TFormPrinc Hint = 'Lecture CV en mode direct sur voie de programmation' Caption = 'Lecture CV - 1 '#224' 255 par le bus XpressNet' Enabled = False - TabOrder = 4 + TabOrder = 3 OnClick = ButtonLitCVClick end - end - object ButtonTest: TButton - Left = 912 - Top = 96 - Width = 89 - Height = 33 - Caption = 'Demande '#233'tat r'#233'trosignalisation' - TabOrder = 5 - WordWrap = True - OnClick = ButtonTestClick - end - object ButtonInfo: TButton - Left = 1008 - Top = 56 - Width = 81 - Height = 33 - Caption = 'Informations' - TabOrder = 6 - OnClick = ButtonInfoClick + object ButtonCommande: TButton + Left = 124 + Top = 24 + Width = 109 + Height = 33 + Hint = 'Ecriture des accessoires DCC' + Caption = 'Envoi commande' + TabOrder = 4 + WordWrap = True + OnClick = ButtonCommandeClick + end end object StatusBar1: TStatusBar Left = 0 @@ -1380,55 +1333,138 @@ object FormPrinc: TFormPrinc 2143341208000000ED030000ED03000001568A64000006000000010000040000 00020000802500000000080000000000000000003F00000011000000} end - object loco: TButton - Left = 1096 - Top = 16 - Width = 75 - Height = 33 - Caption = 'loco' - TabOrder = 9 - OnClick = locoClick - end - object ButtonAffDebug: TButton + object Panel1: TPanel Left = 912 - Top = 56 - Width = 89 - Height = 33 - Caption = 'Affiche debug' - TabOrder = 10 - OnClick = ButtonAffDebugClick + Top = 0 + Width = 273 + Height = 169 + Anchors = [akTop, akRight] + Caption = 'Panel1' + TabOrder = 5 + object BoutonRaf: TButton + Left = 8 + Top = 8 + Width = 89 + Height = 33 + Caption = 'Rafraichissement' + TabOrder = 0 + OnClick = BoutonRafClick + end + object ButtonAffDebug: TButton + Left = 8 + Top = 48 + Width = 89 + Height = 33 + Caption = 'Affiche debug' + TabOrder = 1 + OnClick = ButtonAffDebugClick + end + object BoutVersion: TButton + Left = 102 + Top = 8 + Width = 83 + Height = 33 + Caption = 'Dem version' + TabOrder = 2 + OnClick = BoutVersionClick + end + object loco: TButton + Left = 190 + Top = 8 + Width = 75 + Height = 33 + Caption = 'loco' + TabOrder = 3 + OnClick = locoClick + end + object ButtonInfo: TButton + Left = 104 + Top = 48 + Width = 81 + Height = 33 + Caption = 'Informations' + TabOrder = 4 + OnClick = ButtonInfoClick + end + object ButtonReprise: TButton + Left = 190 + Top = 48 + Width = 75 + Height = 33 + Hint = + 'Relance du bus DCC apr'#232's une '#233'criture d'#39'un CV ou une mise hors t' + + 'ension de la centrale' + Caption = 'Reprise DCC' + TabOrder = 5 + OnClick = ButtonRepriseClick + end + object ButtonTest: TButton + Left = 8 + Top = 88 + Width = 89 + Height = 33 + Caption = 'Demande '#233'tat r'#233'trosignalisation' + TabOrder = 6 + WordWrap = True + OnClick = ButtonTestClick + end + object ButtonArretSimu: TButton + Left = 104 + Top = 88 + Width = 81 + Height = 33 + Caption = 'Arret simulation' + TabOrder = 7 + Visible = False + OnClick = ButtonArretSimuClick + end + object ButtonAffTCO: TButton + Left = 192 + Top = 88 + Width = 73 + Height = 33 + Caption = 'Affiche TCO' + TabOrder = 8 + OnClick = ButtonAffTCOClick + end + object ButtonLanceCDM: TButton + Left = 8 + Top = 128 + Width = 89 + Height = 33 + Caption = 'Lance CDM rail' + TabOrder = 9 + OnClick = ButtonLanceCDMClick + end end - object ButtonReprise: TButton - Left = 1096 - Top = 56 - Width = 75 - Height = 33 - Hint = - 'Relance du bus DCC apr'#232's une '#233'criture d'#39'un CV ou une mise hors t' + - 'ension de la centrale' - Caption = 'Reprise DCC' - TabOrder = 11 - OnClick = ButtonRepriseClick - end - object Button2: TButton - Left = 872 + object Panel2: TPanel + Left = 648 Top = 136 - Width = 97 + Width = 153 Height = 25 - Caption = 'Test' - TabOrder = 12 - Visible = False - OnClick = Button2Click - end - object ButtonArretSimu: TButton - Left = 1008 - Top = 96 - Width = 81 - Height = 33 - Caption = 'Arret simulation' - TabOrder = 13 - Visible = False - OnClick = ButtonArretSimuClick + Anchors = [akTop, akRight] + Caption = 'Panel2' + TabOrder = 6 + object Label1: TLabel + Left = 16 + Top = 4 + Width = 89 + Height = 13 + Caption = 'Nombre de trains : ' + end + object LabelNbTrains: TLabel + Left = 120 + Top = 2 + Width = 9 + Height = 19 + Caption = '0' + Font.Charset = ANSI_CHARSET + Font.Color = clBlack + Font.Height = -16 + Font.Name = 'Arial' + Font.Style = [fsBold] + ParentFont = False + end end object Timer1: TTimer Interval = 100 @@ -1447,8 +1483,7 @@ object FormPrinc: TFormPrinc Left = 320 end object MainMenu1: TMainMenu - Left = 1160 - Top = 8 + Left = 560 object Afficher1: TMenuItem Caption = 'Afficher' object Etatdesdtecteurs1: TMenuItem @@ -1571,11 +1606,11 @@ object FormPrinc: TFormPrinc Left = 352 end object OpenDialog: TOpenDialog - Left = 1104 - Top = 112 + Left = 888 + Top = 152 end object SaveDialog: TSaveDialog - Left = 1120 - Top = 88 + Left = 888 + Top = 16 end end diff --git a/UnitPrinc.pas b/UnitPrinc.pas index 237d6c9..f5217ba 100644 --- a/UnitPrinc.pas +++ b/UnitPrinc.pas @@ -15,16 +15,14 @@ interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, - Dialogs, StdCtrls, OleCtrls, ExtCtrls, jpeg, ComCtrls, ShellAPI, + Dialogs, StdCtrls, OleCtrls, ExtCtrls, jpeg, ComCtrls, ShellAPI, TlHelp32, ImgList, ScktComp, StrUtils, Menus, ActnList, MSCommLib_TLB , unitConfig ; type TFormPrinc = class(TForm) - BoutVersion: TButton; ListBox1: TListBox; Timer1: TTimer; LabelTitre: TLabel; - BoutonRaf: TButton; ScrollBox1: TScrollBox; ClientSocketLenz: TClientSocket; GroupBox1: TGroupBox; @@ -32,9 +30,6 @@ type Label2: TLabel; Editval: TEdit; Label3: TLabel; - ButtonCommande: TButton; - ButtonTest: TButton; - ButtonInfo: TButton; MainMenu1: TMainMenu; Interface1: TMenuItem; MenuConnecterUSB: TMenuItem; @@ -45,8 +40,6 @@ type StatusBar1: TStatusBar; Label4: TLabel; MSCommUSBLenz: TMSComm; - LabelEtat: TLabel; - loco: TButton; Afficher1: TMenuItem; Etatdesdtecteurs1: TMenuItem; Etatdesaiguillages1: TMenuItem; @@ -58,7 +51,6 @@ type Image4feux: TImage; Image3feux: TImage; Image2feux: TImage; - ButtonAffDebug: TButton; N4: TMenuItem; ConnecterCDMrail: TMenuItem; DeconnecterCDMRail: TMenuItem; @@ -74,21 +66,32 @@ type ClientSocketCDM: TClientSocket; FichierSimu: TMenuItem; ButtonEcrCV: TButton; - ButtonReprise: TButton; OpenDialog: TOpenDialog; N1: TMenuItem; LireunfichierdeCV1: TMenuItem; SaveDialog: TSaveDialog; N5: TMenuItem; Quitter1: TMenuItem; - Button2: TButton; Config: TMenuItem; - Label1: TLabel; - LabelNbTrains: TLabel; ButtonLitCV: TButton; Codificationdesactionneurs1: TMenuItem; - ButtonArretSimu: TButton; OuvrirunfichiertramesCDM1: TMenuItem; + Panel1: TPanel; + BoutonRaf: TButton; + ButtonAffDebug: TButton; + BoutVersion: TButton; + loco: TButton; + ButtonInfo: TButton; + ButtonReprise: TButton; + ButtonTest: TButton; + ButtonArretSimu: TButton; + ButtonCommande: TButton; + Panel2: TPanel; + Label1: TLabel; + LabelNbTrains: TLabel; + LabelEtat: TLabel; + ButtonAffTCO: TButton; + ButtonLanceCDM: TButton; procedure FormCreate(Sender: TObject); procedure MSCommUSBLenzComm(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); @@ -138,10 +141,11 @@ type procedure Quitter1Click(Sender: TObject); procedure ConfigClick(Sender: TObject); procedure ButtonLitCVClick(Sender: TObject); - procedure Button2Click(Sender: TObject); procedure Codificationdesactionneurs1Click(Sender: TObject); procedure ButtonArretSimuClick(Sender: TObject); procedure OuvrirunfichiertramesCDM1Click(Sender: TObject); + procedure ButtonAffTCOClick(Sender: TObject); + procedure ButtonLanceCDMClick(Sender: TObject); private { Déclarations privées } procedure DoHint(Sender : Tobject); @@ -160,7 +164,7 @@ LargImg=50;HtImg=91; const_droit=2;const_devie=1; // positions aiguillages transmises par la centrale LENZ const_devieG_CDM=3; // positions aiguillages transmises par cdm const_devieD_CDM=2; // positions aiguillages transmises par cdm -const_droit_CDM=0; // positions aiguillages transmises par cdm +const_droit_CDM=0; // positions aiguillages transmises par cdm 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'); @@ -209,11 +213,14 @@ TMA = (valide,devalide); var ancien_tablo_signalCplx,EtatsignalCplx : array[0..MaxAcc] of word; AvecInitAiguillages,tempsCli,combine,NbreFeux,pasreponse,AdrDevie, NombreImages,signalCpx,branche_trouve,Indexbranche_trouve,Actuel,Signal_suivant, - Nbre_recu_cdm,Tempo_chgt_feux,Adj1,Adj2,NbrePN : integer; + Nbre_recu_cdm,Tempo_chgt_feux,Adj1,Adj2,NbrePN,ServeurInterfaceCDM, + ServeurRetroCDM : integer; Hors_tension2,traceSign,TraceZone,Ferme,parSocket,ackCdm,PremierFD, NackCDM,MsgSim,succes,recu_cv,AffActionneur,AffAigDet, - TraceListe,clignotant,nack,Maj_feux_cours,configNulle : boolean; + TraceListe,clignotant,nack,Maj_feux_cours,configNulle,LanceCDM : boolean; + + CDMhd : THandle; branche : array [1..100] of string; @@ -234,7 +241,7 @@ var DebugOuv,Raz_Acc_signaux,AvecInit,AvecTCO,terminal : boolean; tablo : array of byte; // tableau rx usb Enregistrement,chaine_Envoi,chaine_recue,Id_CDM,Af, - entete,suffixe,ConfStCom : string; + entete,suffixe,ConfStCom,LAY : string; maxaiguillage,detecteur_chgt,Temps,TpsRecuCom,Tempo_init,Suivant,TypeGen, NbreImagePligne,NbreBranches,Index2_det,branche_det,Index_det, I_simule,maxTablo_act,NbreVoies,AdresseFeuSuivant,El_suivant : integer; @@ -273,22 +280,17 @@ var tick : longint; Detecteur,Aiguillage,etat : integer ; end; - Route : array[1..2000] of record - Mem1,Mem2 : integer; - end; TempoAct,RangActCours,N_Cv,index_simule,NDetecteurs,N_Trains,N_routes : integer; tablo_CV : array [1..255] of integer; couleur : Tcolor; fichier : text; - recuCDML : array of string; tick,Premier_tick : longint; // l'indice du tableau aiguillage est son adresse aiguillage : array[0..MaxAcc] of Taiguillage; aiguillageB : array[0..MaxAcc] of Taiguillage; - - // signaux + // signaux/ L'index du tableau n'est pas l'adresse du feu feux : array[1..MaxAcc] of record adresse, aspect : integer; // adresse du feu, aspect (2 feux..9 feux 12=direction 2 feux .. 16=direction 6 feux) Img : TImage; // Pointeur sur structure TImage du feu @@ -308,9 +310,11 @@ var Btype_suiv2 : integer ; // type de l'élément suivant (1=détecteur 2=aig ou TJD ou TJS 4=tri 5=bis Btype_suiv3 : integer ; // type de l'élément suivant (1=détecteur 2=aig ou TJD ou TJS 4=tri 5=bis Btype_suiv4 : integer ; // type de l'élément suivant (1=détecteur 2=aig ou TJD ou TJS 4=tri 5=bis - VerrouCarre : boolean ; // si vrai, le feu se verrouille au carré si pas de train avant le signal - EtatSignal : word ; // comme EtatSignalCplx + VerrouCarre : boolean ; // si vrai, le feu se verrouille au carré si pas de train avant le signal + EtatSignal : word ; // comme EtatSignalCplx UniSemaf : integer ; // définition supplémentaire de la cible pour les décodeurs UNISEMAF + // pour TCO + indexTCO : integer ; // index du feu dans le tableau FeuTCO AigDirection : array[1..6] of array of record // pour les signaux directionnels : contient la liste des aiguillages associés Adresse : integer; // 6 feux max associés à un tableau dynamique décrivant les aiguillages posAig : char; @@ -341,7 +345,7 @@ procedure envoi_signal(Adr : integer); procedure pilote_direction(Adr,nbre : integer); procedure connecte_USB; procedure deconnecte_usb; -function IsWow64Process: Boolean; +function IsWow64Process: Boolean; procedure Dessine_feu_mx(CanvasDest : Tcanvas;x,y : integer;FrX,frY : real;adresse : integer;orientation : integer); implementation @@ -404,10 +408,19 @@ end; procedure dessine_feu2(Acanvas : Tcanvas;x,y : integer;frX,frY : real;EtatSignal : word;orientation : integer); var Temp,code,rayon,xViolet,YViolet,xBlanc,yBlanc, LgImage,HtImage : integer; + ech : real; begin + with ACanvas do + begin + pen.mode:=PmCopy; + Brush.Color:=fond; + pen.color:=clyellow; + end; + code:=code_to_aspect(Etatsignal); // et aspect rayon:=round(6*frX); + // récupérer les dimensions de l'image d'origine du feu LgImage:=Formprinc.Image2feux.Picture.Bitmap.Width; HtImage:=Formprinc.Image2feux.Picture.Bitmap.Height; @@ -417,8 +430,7 @@ begin if (orientation=2) then begin //rotation 90° vers la gauche des feux - frX:=2*LargeurCell/HtImage; - frY:=HauteurCell/LgImage; + ech:=frY;frY:=frX;FrX:=ech; Temp:=HtImage-yViolet;YViolet:=XViolet;XViolet:=Temp; Temp:=HtImage-yBlanc;YBlanc:=XBlanc;XBlanc:=Temp; end; @@ -427,8 +439,7 @@ begin begin //rotation 90° vers la droite des feux // calcul des facteurs de réduction pour la rotation - frX:=2*LargeurCell/HtImage; - frY:=HauteurCell/LgImage; + ech:=frY;frY:=frX;FrX:=ech; Temp:=LgImage-XBlanc;Xblanc:=Yblanc;Yblanc:=Temp; Temp:=LgImage-Xviolet;Xviolet:=Yviolet;Yviolet:=Temp; end; @@ -447,9 +458,17 @@ end; // dessine les feux sur une cible à 3 feux procedure dessine_feu3(Acanvas : Tcanvas;x,y : integer;frX,frY : real;EtatSignal : word;orientation : integer); -var Temp,code,rayon,xSem,Ysem,xJaune,Yjaune,Xvert,Yvert, +var Temp,code,rayon,xSem,Ysem,xJaune,Yjaune,Xvert,Yvert, LgImage,HtImage : integer; + s : string; + ech : real; begin + with ACanvas do + begin + pen.mode:=PmCopy; + Brush.Color:=fond; + pen.color:=clyellow; + end; code:=code_to_aspect(Etatsignal); // et aspect rayon:=round(6*frX); @@ -459,12 +478,10 @@ begin Xvert:=13; Yvert:=11; xSem:=13; ySem:=22; xJaune:=13; yJaune:=33; - + if (orientation=2) then begin - //rotation 90° vers la gauche des feux - frX:=2*LargeurCell/HtImage; - frY:=HauteurCell/LgImage; + ech:=frY;frY:=frX;FrX:=ech; Temp:=HtImage-yjaune;YJaune:=XJaune;Xjaune:=Temp; Temp:=HtImage-ySem;YSem:=XSem;XSem:=Temp; Temp:=HtImage-yvert;Yvert:=Xvert;Xvert:=Temp; @@ -473,9 +490,7 @@ begin if (orientation=3) then begin //rotation 90° vers la droite des feux - // calcul des facteurs de réduction pour la rotation - frX:=2*LargeurCell/HtImage; - frY:=HauteurCell/LgImage; + ech:=frY;frY:=frX;FrX:=ech; Temp:=LgImage-Xjaune;XJaune:=YJaune;Yjaune:=Temp; Temp:=LgImage-XSem;XSem:=YSem;YSem:=Temp; Temp:=LgImage-Xvert;Xvert:=Yvert;Yvert:=Temp; @@ -501,7 +516,14 @@ end; procedure dessine_feu4(Acanvas : Tcanvas;x,y : integer;frX,frY : real;EtatSignal : word;orientation : integer); var Temp,code,rayon,xSem,Ysem,xJaune,Yjaune,Xcarre,Ycarre,Xvert,Yvert, LgImage,HtImage : integer; + ech : real; begin + with ACanvas do + begin + pen.mode:=PmCopy; + Brush.Color:=fond; + pen.color:=clyellow; + end; code:=code_to_aspect(Etatsignal); // et aspect rayon:=round(6*frX); @@ -516,8 +538,7 @@ begin if (orientation=2) then begin //rotation 90° vers la gauche des feux - frX:=2*LargeurCell/HtImage; - frY:=HauteurCell/LgImage; + ech:=frY;frY:=frX;FrX:=ech; Temp:=HtImage-yjaune;YJaune:=XJaune;Xjaune:=Temp; Temp:=HtImage-ycarre;Ycarre:=Xcarre;Xcarre:=Temp; Temp:=HtImage-ySem;YSem:=XSem;XSem:=Temp; @@ -528,8 +549,7 @@ begin begin //rotation 90° vers la droite des feux // calcul des facteurs de réduction pour la rotation - frX:=2*LargeurCell/HtImage; - frY:=HauteurCell/LgImage; + ech:=frY;frY:=frX;FrX:=ech; Temp:=LgImage-Xjaune;XJaune:=YJaune;Yjaune:=Temp; Temp:=LgImage-XSem;XSem:=YSem;YSem:=Temp; Temp:=LgImage-Xvert;Xvert:=Yvert;Yvert:=Temp; @@ -562,6 +582,7 @@ end; procedure dessine_feu5(Acanvas : Tcanvas;x,y : integer;frX,frY : real;EtatSignal : word;orientation : integer); var code, XBlanc,Yblanc,xJaune,yJaune,Xsem,YSem,Xvert,YVert,Xcarre,Ycarre, Temp,rayon,LgImage,HtImage : integer; + ech : real; begin code:=code_to_aspect(Etatsignal); // et aspect rayon:=round(6*frX); @@ -578,8 +599,7 @@ begin begin //rotation 90° vers la gauche des feux // calcul des facteurs de réduction pour la rotation - frX:=2*LargeurCell/HtImage; - frY:=HauteurCell/LgImage; + ech:=frY;frY:=frX;FrX:=ech; Temp:=HtImage-yjaune;YJaune:=XJaune;Xjaune:=Temp; Temp:=HtImage-yBlanc;YBlanc:=XBlanc;XBlanc:=Temp; Temp:=HtImage-ycarre;Ycarre:=Xcarre;Xcarre:=Temp; @@ -591,8 +611,7 @@ begin begin //rotation 90° vers la droite des feux // calcul des facteurs de réduction pour la rotation - frX:=2*LargeurCell/HtImage; - frY:=HauteurCell/LgImage; + ech:=frY;frY:=frX;FrX:=ech; Temp:=LgImage-Xjaune;XJaune:=YJaune;Yjaune:=Temp; Temp:=LgImage-XSem;XSem:=YSem;YSem:=Temp; Temp:=LgImage-Xvert;Xvert:=Yvert;Yvert:=Temp; @@ -630,7 +649,15 @@ end; procedure dessine_feu7(Acanvas : Tcanvas;x,y : integer;frX,frY : real;EtatSignal : word;orientation : integer); var code, XBlanc,Yblanc,xJaune,yJaune,Xsem,YSem,Xvert,YVert,Xcarre,Ycarre,Xral1,Yral1,Xral2,YRal2, Temp,rayon,LgImage,HtImage : integer; + ech : real; begin + with ACanvas do + begin + pen.mode:=PmCopy; + Brush.Color:=fond; + pen.color:=clyellow; + end; + code:=code_to_aspect(Etatsignal); // et combine rayon:=round(6*frX); XBlanc:=13; YBlanc:=23; @@ -648,8 +675,7 @@ begin begin //rotation 90° vers la gauche des feux // calcul des facteurs de réduction pour la rotation - frX:=2*LargeurCell/HtImage; - frY:=HauteurCell/LgImage; + ech:=frY;frY:=frX;FrX:=ech; Temp:=HtImage-yjaune;YJaune:=XJaune;Xjaune:=Temp; Temp:=HtImage-yBlanc;YBlanc:=XBlanc;XBlanc:=Temp; Temp:=HtImage-yRal1;YRal1:=XRal1;XRal1:=Temp; @@ -663,8 +689,7 @@ begin begin //rotation 90° vers la droite des feux // calcul des facteurs de réduction pour la rotation - frX:=2*LargeurCell/HtImage; - frY:=HauteurCell/LgImage; + ech:=frY;frY:=frX;FrX:=ech; Temp:=LgImage-Xjaune;XJaune:=YJaune;Yjaune:=Temp; Temp:=LgImage-XSem;XSem:=YSem;YSem:=Temp; Temp:=LgImage-Xvert;Xvert:=Yvert;Yvert:=Temp; @@ -715,7 +740,14 @@ var code,rayon, XBlanc,Yblanc,xJaune,yJaune,Xsem,YSem,Xvert,YVert,Xcarre,Ycarre,Xral1,Yral1,Xral2,YRal2, Xrap1,Yrap1,Xrap2,Yrap2,Temp : integer; LgImage,HtImage,xt,yt : integer; + ech : real; begin + with ACanvas do + begin + pen.mode:=PmCopy; + Brush.Color:=fond; + pen.color:=clyellow; + end; rayon:=round(6*frX); code:=code_to_aspect(Etatsignal); // et aspect // mise à l'échelle des coordonnées des feux en fonction du facteur de réduction frX et frY et x et y (offsets) @@ -736,9 +768,7 @@ begin if (orientation=2) then begin //rotation 90° vers la gauche des feux - // calcul des facteurs de réduction pour la rotation - frX:=2*LargeurCell/HtImage; - frY:=HauteurCell/LgImage; + ech:=frY;frY:=frX;FrX:=ech; Temp:=HtImage-yjaune;YJaune:=XJaune;Xjaune:=Temp; Temp:=HtImage-yBlanc;YBlanc:=XBlanc;XBlanc:=Temp; Temp:=HtImage-yRal1;YRal1:=XRal1;XRal1:=Temp; @@ -753,9 +783,7 @@ begin if (orientation=3) then begin //rotation 90° vers la droite des feux - // calcul des facteurs de réduction pour la rotation - frX:=2*LargeurCell/HtImage; - frY:=HauteurCell/LgImage; + ech:=frY;frY:=frX;FrX:=ech; Temp:=LgImage-Xjaune;XJaune:=YJaune;Yjaune:=Temp; Temp:=LgImage-XSem;XSem:=YSem;YSem:=Temp; Temp:=LgImage-Xvert;Xvert:=Yvert;Yvert:=Temp; @@ -817,7 +845,6 @@ begin end; - // dessine les feux sur une cible directionnelle à 2 feux procedure dessine_dir3(Acanvas : Tcanvas;EtatSignal : word); begin @@ -1088,29 +1115,6 @@ begin end; end; -// dessine l'aspect du feu en fonction de son adresse dans la partie droite de droite -procedure Dessine_feuxx(adresse : integer); -var i : integer; -begin - i:=Index_feu(adresse); - if i<>0 then - case feux[i].aspect of - // feux de signalisation - 2 : dessine_feu2(Feux[i].Img.Canvas,0,0,1,1,EtatSignalCplx[adresse],1); - 3 : dessine_feu3(Feux[i].Img.Canvas,0,0,1,1,EtatSignalCplx[adresse],1); - 4 : dessine_feu4(Feux[i].Img.Canvas,0,0,1,1,EtatSignalCplx[adresse],1); - 5 : dessine_feu5(Feux[i].Img.Canvas,0,0,1,1,EtatSignalCplx[adresse],1); - 7 : dessine_feu7(Feux[i].Img.Canvas,0,0,1,1,EtatSignalCplx[adresse],1); - 9 : dessine_feu9(Feux[i].Img.Canvas,0,0,1,1,EtatSignalCplx[adresse],1); - // indicateurs de direction - 12 : dessine_dir2(Feux[i].Img.Canvas,EtatSignalCplx[adresse]); - 13 : dessine_dir3(Feux[i].Img.Canvas,EtatSignalCplx[adresse]); - 14 : dessine_dir4(Feux[i].Img.Canvas,EtatSignalCplx[adresse]); - 15 : dessine_dir5(Feux[i].Img.Canvas,EtatSignalCplx[adresse]); - 16 : dessine_dir6(Feux[i].Img.Canvas,EtatSignalCplx[adresse]); - end; -end; - Procedure TFormprinc.ImageOnClick(Sender : Tobject); var s : string; P_image_pilote : Timage; @@ -1756,7 +1760,6 @@ begin // signalisation combinée - rappel 30 + avertissement - à tester...... if (Combine=0) then pilote_acc(adresse+2,1,feu) ; // éteindre rappel 30 if (Combine=rappel_30) then pilote_acc(adresse+2,2,feu) ; // allumer rappel 30 - Dessine_feu_mx(Feux[Index_Feu(adresse)].Img.Canvas,0,0,1,1,adresse,1); end; end; @@ -1834,7 +1837,6 @@ begin if ((Combine=rappel_60) and (aspect=jaune)) then envoi5_LEB($10); if ((Combine=rappel_60) and (aspect=jaune_cli)) then envoi5_LEB($11); if ((Combine=ral_60) and (aspect=jaune_cli)) then envoi5_LEB($12); - Dessine_feu_mx(Feux[Index_Feu(adr)].Img.Canvas,0,0,1,1,adr,1); end; end; @@ -1921,7 +1923,6 @@ begin if (Combine=rappel_60) and (aspect=jaune_cli) then valeur:=18; pilote_acc(adresse,valeur,feu); - Dessine_feu_mx(Feux[Index_Feu(adresse)].Img.Canvas,0,0,1,1,adresse,1); end; end; @@ -2219,7 +2220,6 @@ begin end; if (code=jaune) and (combine=rappel_60) then pilote_acc(adresse+3,1,feu); end; - Dessine_feu_mx(Feux[Index_Feu(adresse)].Img.Canvas,0,0,1,1,adresse,1); end; end; @@ -2277,7 +2277,6 @@ begin if (aspect=rappel_60) then begin pilote_acc(adr+3,2,feu);sleep(tempoFeu);pilote_acc(adr+1,2,feu);end; end; end; - Dessine_feu_mx(Feux[Index_Feu(adr)].Img.Canvas,0,0,1,1,adr,1); end; end; @@ -2293,7 +2292,6 @@ begin aspect:=code_to_aspect(code); // transforme le motif de bits en numéro "code des aspects des signaux" if (tracesign) then Affiche('Signal virtuel: ad'+intToSTR(adresse)+'='+etatSign[aspect],clOrange); if AffSignal then AfficheDebug('Signal virtuel: ad'+intToSTR(adresse)+'='+etatSign[aspect],clOrange); - Dessine_feu_mx(Feux[Index_Feu(adresse)].Img.Canvas,0,0,1,1,adresse,1); end; end; @@ -2304,7 +2302,6 @@ envoie les donn adressant l'une des 14 adresses pour les 14 leds possibles du feu. Ici on met le bit 1 à 1 (état "vert" du programme hexmanipu ===========================================================================*) -//procedure envoi_signalBahn(adresse,codebin : integer); procedure envoi_signalBahn(adresse : integer); var aspect,combineLoc,codebin : integer; ralrap, jau ,Ancralrap,Ancjau : boolean; @@ -2365,7 +2362,7 @@ begin sleep(40); pilote_ACC(adresse+CombineLoc,2,feu) ; end; - Dessine_feu_mx(Feux[Index_Feu(adresse)].Img.Canvas,0,0,1,1,adresse,1); + end; end; @@ -3224,10 +3221,13 @@ end; // de la proc // pilotage d'un signal procedure envoi_signal(Adr : integer); -var i : integer; +var i,adresse,a,aspect,x,y,TailleX,TailleY,Orientation : integer; + ImageFeu : TImage; + frX,frY : real; begin i:=index_feu(Adr); - if feux[i].aspect<10 then + if feux[i].aspect<10 then + begin case feux[i].decodeur of 0 : envoi_virtuel(Adr); 1 : envoi_signalBahn(Adr); @@ -3236,7 +3236,52 @@ begin 4 : envoi_LEB(Adr); 5 : envoi_NMRA(Adr); 6 : envoi_UniSemaf(Adr); - end; + end; + // dessine le feu dans la fenêtre de droite + Dessine_feu_mx(Feux[i].Img.Canvas,0,0,1,1,adresse,1); + + // dessine le feu du TCO + if AvecTCO then + begin + for i:=1 to NbFeuTCO do + begin + adresse:=FeuTCO[i].adresse; + if adresse<>0 then + begin + a:=EtatsignalCplx[adresse]; // a = état binaire du feu + aspect:=feuTCO[i].aspect; + case aspect of + 2 : ImageFeu:=Formprinc.Image2feux; + 3 : ImageFeu:=Formprinc.Image3feux; + 4 : ImageFeu:=Formprinc.Image4feux; + 5 : ImageFeu:=Formprinc.Image5feux; + 7 : ImageFeu:=Formprinc.Image7feux; + 9 : ImageFeu:=Formprinc.Image9feux; + else ImageFeu:=Formprinc.Image3feux; + end; + x:=(FeuTCO[i].x-1)*LargeurCell; // coordonnées XY et feu + y:=(FeuTCO[i].y-1)*HauteurCell; + TailleY:=ImageFeu.picture.BitMap.Height; // taille du feu d'origine (verticale) + TailleX:=ImageFeu.picture.BitMap.Width; + Orientation:=FeuTCO[i].FeuOriente; + // réduction variable en fonction de la taille des cellules + calcul_reduction(frx,fry,round(TailleX*LargeurCell/ZoomMax),round(tailleY*HauteurCell/ZoomMax),TailleX,TailleY); + + // décalage en X pour mettre la tete du feu alignée sur le bord droit de la cellule pour les feux tournés à 90G + if orientation=2 then + begin + if aspect=9 then x:=x+round(10*frX); + if aspect=7 then x:=x+round(10*frX); + if aspect=5 then begin x:=x+round(10*frX);y:=y+HauteurCell-round(tailleX*frY); end; + if aspect=4 then begin x:=x+round(10*frX);y:=y+HauteurCell-round(tailleX*frY); end; + if aspect=3 then begin x:=x+round(10*frX);y:=y+HauteurCell-round(tailleX*frY); end; + if aspect=2 then begin x:=x+round(10*frX);y:=y+HauteurCell-round(tailleX*frY); end; + end; + Dessine_feu_mx(PCanvasTCO,x,y,frx,fry,adresse,orientation); + end; + end; + end; + end; end; // pilotage des signaux @@ -3408,7 +3453,7 @@ begin val(s,TimoutMaxInterface,erreur); if erreur<>0 then Affiche('Erreur temporisation maximale interface',clred); - //entete + // entete s:=lit_ligne; val(s,Valeur_entete,erreur); entete:=''; @@ -3420,7 +3465,7 @@ begin if (erreur<>0) or (valeur_entete>2) then Affiche('Erreur déclaration variable entete',clred); - //avec ou sans initialisation des aiguillages + // avec ou sans initialisation des aiguillages s:=lit_ligne; AvecInitAiguillages:=StrToINT(s); @@ -3431,31 +3476,66 @@ begin j:=pos(',',s); if j>1 then begin - adresse:=StrToINT(copy(s,1,j-1));Delete(s,1,j); // adresse aiguillage - if (adresse>0) then begin - j:=pos(',',s); - position:=StrToInt(copy(s,1,j-1));Delete(S,1,j);// position aiguillage - if (position<1) or (position>2) then position:=1; - aiguillage[adresse].position:=position; - aiguillageB[adresse].position:=position; + adresse:=StrToINT(copy(s,1,j-1));Delete(s,1,j); // adresse aiguillage + if (adresse>0) and (AvecInitAiguillages=1) then + begin + j:=pos(',',s); + position:=StrToInt(copy(s,1,j-1));Delete(S,1,j);// position aiguillage + if (position<1) or (position>2) then position:=1; + aiguillage[adresse].position:=position; + aiguillageB[adresse].position:=position; - // temporisation aiguillage - j:=pos(',',s);if j=0 then j:=length(s); - val(s,temporisation,erreur);Delete(S,1,j); - if (temporisation<0) or (temporisation>10) then temporisation:=5; - aiguillage[adresse].temps:=temporisation; - aiguillageB[adresse].temps:=temporisation; - - val(s,invers,erreur); - if (invers<0) or (invers>1) then invers:=0; // inversion commande - aiguillage[adresse].inversion:=invers; - aiguillageB[adresse].inversion:=invers; - + // temporisation aiguillage + j:=pos(',',s);if j=0 then j:=length(s); + val(s,temporisation,erreur);Delete(S,1,j); + if (temporisation<0) or (temporisation>10) then temporisation:=5; + aiguillage[adresse].temps:=temporisation; + aiguillageB[adresse].temps:=temporisation; + + val(s,invers,erreur); + if (invers<0) or (invers>1) then invers:=0; // inversion commande + aiguillage[adresse].inversion:=invers; + aiguillageB[adresse].inversion:=invers; + end; end; end; until (adresse=0); + + // vérification de la version au démarrage + verifVersion:=true; + s:=lit_ligne; + val(s,i,erreur); + if erreur=0 then verifVersion:=i=1; + + // notification de nouvelle version au démarrage + s:=lit_ligne; + val(s,i,erreur); + notificationVersion:=i=1; + // avec tco + s:=lit_ligne; + val(s,i,erreur); + AvecTCO:=i=1; + + // lancement de CDM + s:=lit_ligne; + val(s,i,erreur); + LanceCDM:=i=1; + + // Nom du LAY + Lay:=Lit_Ligne; + + // Serveur d'interface de CDM + s:=lit_ligne; + val(s,i,erreur); + ServeurInterfaceCDM:=i; + + // Serveur de rétrosignalisation de CDM + s:=lit_ligne; + val(s,i,erreur); + ServeurRetroCDM:=i; + closefile(fichier); Affiche('lecture du fichier de configuration config.cfg',clyellow); @@ -3810,7 +3890,10 @@ begin else // feu de signalisation begin - feux[i].aspect:=StrToInt(sa);Delete(s,1,j); + k:=StrToInt(sa); //aspect + feux[i].aspect:=k;Delete(s,1,j); + if (k=0) or (k=6) or (k>9) then + Affiche('Fichier config.cfg: configuration aspect ('+intToSTR(k)+') feu incorrecte à la ligne '+chaine,clRed); j:=pos(',',s); if j>1 then begin Feux[i].FeuBlanc:=(copy(s,1,j-1))='1';delete(s,1,j);end; j:=pos(',',s); @@ -4106,7 +4189,7 @@ begin end; // trouve un élément dans les branches, renvoie branche_trouve IndexBranche_trouve -// el : adresse de l'élément TypeEL=(1=détécteur 2=aig 3=aig Bis) +// el : adresse de l'élément TypeEL=(1=détécteur 2=aig 3=aig Bis 4=aig triple) procedure trouve_element(el : integer;TypeEl : integer); var i,Btype,adr,Branche : integer ; s : string; @@ -4122,9 +4205,12 @@ begin if ((adr=0) and (Btype=0)) then begin inc(Branche);i:=0;end; inc(i); sort:=(Branche>NbreBranches) or + ((adr=el) and (TypeEl=5) and (Btype=3)) or //typeEl=5=aig bis + ((adr=el) and (TypeEl=4) and (Btype=2)) or //typeEl=4=aig triple ((adr=el) and (TypeEl=3) and (Btype=3)) or ((adr=el) and (TypeEl=2) and (Btype=2)) or - ((adr=el) and (TypeEl=1) and (Btype=1)) ; + ((adr=el) and (TypeEl=1) and (Btype=1)) or + ((adr=el) and (TypeEl=1) and (Btype=4)) ; //buttoir until (sort); if (adr=el) then begin @@ -4323,12 +4409,12 @@ begin begin if prec<>aiguillage[Adr].Adevie then begin - if NivDebug=3 then AfficheDebug('Aiguillage '+intToSTR(adr)+' mal positionné',clyellow); + if NivDebug=3 then AfficheDebug('135.3 Aiguillage '+intToSTR(adr)+' mal positionné',clyellow); suivant_alg3:=9998;exit; end else begin - if NivDebug=3 then AfficheDebug('Aiguillage '+intToSTR(adr)+' bien positionné',clyellow); + if NivDebug=3 then AfficheDebug('135.4 Aiguillage '+intToSTR(adr)+' bien positionné',clyellow); end; end; end; @@ -4778,7 +4864,7 @@ begin trouve_element(adresse,1); // branche_trouve IndexBranche_trouve if (IndexBranche_trouve=0) then begin - Affiche('élément '+IntToSTR(adresse)+' non trouvé',clred); + Affiche('Erreur 380 : élément '+IntToSTR(adresse)+' non trouvé',clred); exit; end; IndexBranche:=IndexBranche_trouve; @@ -4834,7 +4920,9 @@ begin trouve_element(el1,Typedet1); // branche_trouve IndexBranche_trouve if (IndexBranche_trouve=0) then begin - Affiche('élément '+IntToSTR(el1)+' non trouvé',clred); + s:='Erreur 381 : élément '+IntToSTR(el1)+' non trouvé'; + Affiche(s,clred); + if NivDebug=3 then AfficheDebug(s,clred); detecteur_suivant_El:=1;exit; end; IndexBranche_det1:=IndexBranche_trouve; @@ -4844,7 +4932,9 @@ begin trouve_element(el2,TypeDet2); // branche_trouve IndexBranche_trouve if (IndexBranche_trouve=0) then begin - Affiche('élément '+IntToSTR(el2)+' non trouvé',clred); + s:='Erreur 382 : élément '+IntToSTR(el2)+' non trouvé'; + Affiche(s,clred); + if NivDebug=3 then AfficheDebug(s,clred); detecteur_suivant_El:=2;exit; end; @@ -5469,7 +5559,7 @@ end; // mise à jour de l'état d'un feu en fontion de son environnement et affiche le feu procedure Maj_Feu(Adrfeu : integer); var i,j,k1,k2,BtypeSuiv,Adr_det,etat,Adr,Aig,DetPrec1,DetPrec2,Detprec3,Detprec4,Adr_El_Suiv, - Btype_el_suivant,det_initial,bt,el_suiv,modele : integer ; + Btype_el_suivant,det_initial,bt,el_suiv,modele,code : integer ; PresTrain,Aff_semaphore,car : boolean; s : string; begin @@ -5494,8 +5584,15 @@ begin // signal non directionnel etat:=etat_signal_suivant(AdrFeu,1) ; // état du signal suivant + adresse du signal suivant dans Signal_Suivant - if AffSignal then AfficheDebug('Etat signal suivant ('+intToSTR(AdresseFeuSuivant)+') est '+intToSTR(etat),clyellow); - + if AffSignal then + begin + code:=code_to_aspect(etat); + s:='Etat signal suivant ('+intToSTR(AdresseFeuSuivant)+') est '; + s:=s+' à '+etatSign[code]; + if Combine<>0 then s:=s+' + '+etatSign[combine]; + AfficheDebug(s,clyellow); + end; + // signaux traités spécifiquement if (AdrFeu=201) then begin @@ -5587,7 +5684,15 @@ begin if AffSignal then AfficheDebug('les détecteurs précédents au feu '+IntToSTR(Adrfeu)+' sont:'+intToSTR(Det_initial)+' '+intToSTR(DetPrec1)+' '+intToSTR(DetPrec2)+' '+intToSTR(DetPrec3)+' ',clyellow); PresTrain:=//MemZone[DetPrec4,detPrec3] or MemZone[DetPrec3,detPrec2] or MemZone[DetPrec2,detPrec1] or MemZone[DetPrec1,Det_initial] or presTrain ; - // Affiche('MemZone'+intToSTR(DetPrec3)+' '+IntToSTR(detPrec2) = '+MemZone[DetPrec3,detPrec2] + if AffSignal then + begin + if MemZone[DetPrec3,detPrec2] then AfficheDebug('1.présence train '+IntToSTR(DetPrec3)+' '+IntToSTR(detPrec2),clyellow); + if MemZone[DetPrec2,detPrec1] then AfficheDebug('2.présence train '+IntToSTR(DetPrec2)+' '+IntToSTR(detPrec1),clyellow); + if MemZone[DetPrec1,det_initial] then AfficheDebug('3.présence train '+IntToSTR(DetPrec1)+' '+IntToSTR(det_Initial),clyellow); + + //if PresTrain then AfficheDebug('présence train',clyellow) else afficheDebug('abscence train',clyellow); + end; + //if AffSignal then AfficheDebug('MemZone'+intToSTR(DetPrec3)+' '+IntToSTR(detPrec2) = '+MemZone[DetPrec3,detPrec2] end; end; end; @@ -5688,12 +5793,6 @@ begin end end; -// met à jour le signal adr dont le détecteur vient d'être franchi dans le bon sens -procedure signal(SignalCplx,detecteurAct,detecteurSuiv : integer); -begin - if MemZone[detecteurAct,detecteurSuiv] then if testBit(EtatSignalCplx[signalCplx],carre)=FALSE then Maj_Etat_Signal(signalCplx,semaphore); -end; - // trouve l'index d'un détecteur dans une branche depuis la fin de la branche // si pas trouvé, renvoie 0 function index_detecteur_fin(det,Num_branche : integer) : integer; @@ -5733,8 +5832,8 @@ end; // calcul des zones depuis le tableau des fronts descendants des évènements détecteurs // transmis dans le tableau Event_det -procedure calcul_zones_V2; -var Nbre,Nouveau_Det,i,resultat,det1,det2,det3,AdrSuiv : integer ; +procedure calcul_zones; +var AdrFeu,AdrDetFeu,Nbre,Nouveau_Det,i,resultat,det1,det2,det3,AdrSuiv,TypeSuiv,AdrPrec : integer ; creer_tableau : boolean; s : string; begin @@ -5838,6 +5937,27 @@ begin Affiche('Erreur nombre de train maximal atteint',clRed); end; Inc(N_trains); + + // vérifier si le détecteur du nouveau train est associé à un feu vers un buttoir + for i:=1 to NbreFeux do + begin + AdrFeu:=Feux[i].Adresse; + AdrDetfeu:=Feux[i].Adr_Det1; + if (AdrDetFeu=Det3) and (feux[i].aspect<10) then + begin + AdrSuiv:=Feux[i].Adr_el_suiv1;TypeSuiv:=Feux[i].Btype_suiv1; + AdrPrec:=detecteur_suivant(AdrSuiv,typeSuiv,AdrDetFeu,1) ; // détecteur précédent le feu + if AdrPrec=0 then + begin + if TraceListe then Affiche('FD - Le feu '+IntToSTR(AdrFeu)+' est précédé d''un buttoir',clyellow); + MemZone[0,AdrDetFeu]:=false; + //NivDebug:=3; + AffSignal:=true; + maj_feu(AdrFeu); + end; + end; + end; + if TraceListe then AfficheDebug('Création Train n°'+intToSTR(i),clyellow); Formprinc.LabelNbTrains.caption:=IntToSTR(N_trains); event_det_train[N_trains].det[1]:=det3; @@ -5855,78 +5975,6 @@ begin end; -// calcul des zones depuis le tableau des fronts descendants des évènements détecteurs -// transmis dans le tableau Event_det -// appellé par front descendant sur détecteur -// met à jour le tableau MemZone -(* plus utilisé -procedure calcul_zones ; -var i,det1,det2,index_1,index_2,index_3,resultat : integer; - unevalide : boolean; - s : string; - label refaire; -begin - uneValide:=false; - //N_event_det pointe sur le dernier détecteur - refaire: - - affiche_Event_det; - - if N_event_det<2 then begin exit;end; // pas assez de détecteurs pour évaluer - // balayer index 1 à 2 puis 1 à 3 puis 1 à N_event_det et ensuite - // de 2 à 3 puis de 2 à 4 puis de 2 à 5 etc - index_1:=1; - repeat - index_2:=index_1+1; - repeat - //det0:=event_det[index_ - det1:=event_det[index_1]; - det2:=event_det[index_2]; - //if det1=det2 then // si détecteurs identiques, supprimer le 2eme - //begin - // if traceListe then AfficheDebug('trouvé doublon ('+intToSTR(dat1)+')',clyellow); - // supprime_event(index_2); - // //if traceListe then for index_3:=1 to N_event_det do affiche(intToSTR(event_det[index_3]),clyellow); - // goto refaire; - //end; - - if det2=detecteur_chgt then // on cherche la route pour le 2eme détecteur qui vient de changer - begin - if traceListe then - begin - AfficheDebug('-------Cherche route de '+intToSTR(det1)+' à '+intToSTR(det2)+' i1='+intToSTR(index_1)+' i2='+intToSTR(index_2)+' n='+intToSTR(N_event_det),clyellow); - end; - resultat:=calcul_zones_det(det1,det2); - if resultat=10 then - begin - s:='route traitée de '+intToSTR(det1)+' à '+IntToSTR(det2)+' Mem '+intToSTR(det2)+' à '+IntToSTR(El_suivant); - FormDebug.MemoEvtDet.lines.add(s); - if traceListe then AfficheDebug(s,clyellow); - uneValide:=true; - FormDebug.MemoEvtDet.lines.add('Nouveau Tampon:'); - if traceListe then AfficheDebug('Nouveau Tampon',clyellow); - affiche_Event_det; - end; - - // détecteur1 non trouvé - if resultat=1 then begin supprime_event(index_1);goto refaire;end; - // détecteur2 non trouvé - if resultat=2 then begin supprime_event(index_2);goto refaire;end; - - end; - inc(index_2); - //Affiche('index2='+IntToSTR(index_2),clyellow); - until (index_2>N_event_det); - inc(index_1); - until (index_1>=N_event_det); - // si on a trouvé au moins une route valide, rafraichir les signaux - if uneValide then - begin - rafraichit; - rafraichit; - rafraichit; - end; -end; *) // demande l'état d'un accessoire à la centrale. Le résultat sera réceptionné sur réception des informations // de rétrosignalisation. @@ -6023,13 +6071,14 @@ end; // traitement sur les évènements détecteurs procedure Event_Detecteur(Adresse : integer;etat : boolean); -var i,trainAdj1,TrainAdj2,TrainActuel,Etat01 : integer; +var i,AdrSuiv,AdrFeu,AdrDetfeu,TrainActuel,Etat01,typeSuiv,AdrPrec : integer; s : string; begin if Etat then Etat01:=1 else Etat01:=0; // vérifier si l'état du détecteur est déja stocké, car on peut reçevoir plusieurs évènements pour le même détecteur dans le même état // on reçoit un doublon dans deux index consécutifs. +(* if N_Event_tick>=1 then begin if (event_det_tick[N_event_tick].etat=etat01) and (event_det_tick[N_event_tick].detecteur=Adresse) then @@ -6038,7 +6087,7 @@ begin exit; // déja stocké end; end; - + *) if Traceliste then AfficheDebug('--------------------- détecteur '+intToSTR(Adresse)+' à '+intToSTR(etat01)+'-----------------------------',clOrange); if AffAigDet then begin @@ -6056,20 +6105,48 @@ begin // stocke les changements d'état des détecteurs dans le tableau chronologique if (N_Event_tickAdresse then + //if event_det[N_event_det]<>Adresse then begin if AffFD then AfficheDebug('index='+intToSTR(N_event_tick)+' FD '+intToSTR(Adresse),clyellow); inc(N_event_det); @@ -6082,13 +6159,15 @@ begin if aiguillage[i].modele<>0 then begin if aiguillage[i].position=9 then - Affiche('Attention : position de l''aiguillage '+IntToSTR(i)+' inconnue',clred); - AfficheDebug('Attention : position de l''aiguillage '+IntToSTR(i)+' inconnue',clred); + begin + Affiche('Attention : position de l''aiguillage '+IntToSTR(i)+' inconnue',clred); + AfficheDebug('Attention : position de l''aiguillage '+IntToSTR(i)+' inconnue',clred); + end; end; end; end; premierFD:=True; - if not(configNulle) then calcul_zones_V2; // en avant les calculs + if not(configNulle) then calcul_zones; // en avant les calculs end; end; @@ -6104,7 +6183,7 @@ begin // Mettre à jour le TCO if AvecTCO then begin - formTCO.Maj_TCO(Adresse,etat); + formTCO.Maj_TCO(Adresse); end; end; @@ -6144,10 +6223,8 @@ begin begin if pos=const_devie then aiguillageB[adresse].position:=const_droit; if pos=const_droit then aiguillageB[adresse].position:=const_devie; - end; - // ------------- stockage évènement aiguillage dans tampon event_det_tick ------------------------- if (N_Event_tickconst_droit then - begin - Adet:=aiguillage[adresse].Adevie; - if aiguillage[adresse].AdevieB='Z' then Btype:=1 else Btype:=2; - end; - - if Btype<>1 then - begin - BtypeE:=Btype; - AdresseE:=Adresse; - i:=0; - repeat - // trouver le détecteur avant l'aiguillage - attention prévoir aiguillage BIS (btype=3) - Det_Suiv:=suivant_alg3(adresseE,BtypeE,Adet,Btype,1) ; - adresseE:=Adet; BtypeE:=Btype; - Adet:=Det_Suiv;Btype:=TypeGen; - inc(i); - until (typeGen=1) or (i>20); - end; - if (i>20) then begin Affiche('Erreur 671',clRed);exit;end; - Affiche('le détecteur suivant sur aiguillage '+intToSTR(adresse)+' est '+intToSTR(Adet),clyellow); - - // étape 2 : trouver si un train est sur le détecteur dans le tableau event_det_tick - i:=N_Event_tick; - repeat - dec(i); - trouve:=event_det_tick[i].detecteur[Adet]=1; // si le détecteur à rechercher en amont de la liste est à "etat" - //train:=event_det_tick[i].train; - index:=i; - until trouve or (i=1); - if trouve then - begin - Affiche('détecteur '+intToSTR(Adet)+' à 1',clyellow); - // il y a a un train dessus, - det_adj(Adet); // trouver les détecteurs adjacents (adj1 et adj2) - Affiche('Adj1='+intToSTR(Adj1)+' Adj2='+intToSTR(Adj2),clyellow); - // trouver le détecteur adjacent - i:=N_Event_tick; - trouve1:=false;trouve2:=false; - repeat - dec(i); - if not(trouve1) then - begin - trouve1:=event_det_tick[i].detecteur[Adj1]=1;index1:=i; // si le détecteur - train1:=event_det_tick[index1].train; - end; - if not(trouve2) then - begin - trouve2:=event_det_tick[i].detecteur[Adj2]=1;index2:=i; - train2:=event_det_tick[index2].train; - end; // si le détecteur à rechercher en amont de la liste est à 1 - until (trouve1 and trouve2) or (i=1); - - if not(trouve1) and not(trouve2) then affiche('pas trouve adj1 ni adj2 à 1',clOrange); - if trouve1 and (train1=train) then - begin - Affiche(' détecteur Adj1='+intToSTR(Adj1)+' train='+intToSTR(train),clyellow); - event_det_tick[index1].suivant:=Adet; - event_det_tick[index].suivant:=Adj2; - - end; - if trouve2 and (train2=train) then - begin - Affiche(' détecteur Adj2='+intToSTR(Adj2)+' train='+intToSTR(train),clyellow); - event_det_tick[index2].suivant:=Adet; - event_det_tick[index].suivant:=Adj1; - end; - - - end; - } + end; -// le décodage de la rétro est appellée sur une réception d'une trame de la rétrosignalisation. -// On déclenche ensuite le rafraichissement +// le décodage de la rétro est appellée sur une réception d'une trame de la rétrosignalisation de la centrale. +// On déclenche ensuite les évènements détecteurs ou aiguillages. procedure decode_retro(adresse,valeur : integer); var s : string; adraig,bitsITT,i : integer; @@ -6380,7 +6380,7 @@ begin end; -// décodage d'une chaine simple de la rétrosignalisation +// décodage d'une chaine simple de la rétrosignalisation de la centrale function decode_chaine_retro(chaineINT : string) : string ; var msg : string; i,cvLoc : integer; @@ -6568,12 +6568,12 @@ end; // vérifie si version OS32 bits ou OS64 bits function IsWow64Process: Boolean; type - TIsWow64Process = function(hProcess: THandle; var Wow64Process: Boolean): Boolean; stdcall; + TIsWow64Process=function(hProcess: THandle; var Wow64Process: Boolean): Boolean; stdcall; var DLL: THandle; pIsWow64Process: TIsWow64Process; const - IsWow64: Boolean = False; + IsWow64: Boolean=False; begin IsWow64:=false; DLL:=LoadLibrary('kernel32.dll'); @@ -6590,9 +6590,9 @@ begin end; {$J-} +// initialisation de la comm USB procedure connecte_USB; begin -// initialisation de la comm USB if NumPort<>0 then begin With Formprinc.MSCommUSBLenz do @@ -6643,12 +6643,230 @@ begin end; +Function GetWindowFromID(ProcessID : Cardinal): THandle; +Var TestID : Cardinal; + TestHandle : Thandle; +Begin + Result:=0; + TestHandle:=FindWindowEx(GetDesktopWindow,0,Nil,Nil); + while TestHandle>0 do + begin + if GetParent(TestHandle)=0 then GetWindowThreadProcessId(TestHandle,@TestID); + if TestID=ProcessID then + begin + Result:=TestHandle; + exit; + end; + TestHandle:=GetWindow(TestHandle,GW_HWNDNEXT) + end; +end; + +// renvoie si un process EXE tourne. Renvoie le Handle du process dans CDMHd et l'Id du process dans ProcessID +// sExeName : Nom de l'EXE sans le chemin, et sans EXE } +function ProcessRunning(sExeName: String) : Boolean; +var + hSnapShot : THandle; + ProcessEntry32 : TProcessEntry32; // pointeur sur la structure ProcessEntry32 + processID : DWord; +begin + Result:=false; + + hSnapShot:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0); + Win32Check(hSnapShot <> INVALID_HANDLE_VALUE); + + sExeName:=LowerCase (sExeName); + + FillChar(ProcessEntry32,SizeOf(TProcessEntry32),#0); + ProcessEntry32.dwSize:=SizeOf(TProcessEntry32); // contient la structure de tous les process + + if (Process32First(hSnapShot,ProcessEntry32)) then + repeat + //Affiche(ProcessEntry32.szExeFile,ClYellow); + if (Pos(sExeName,LowerCase(ProcessEntry32.szExeFile))=1) then + begin + processID:=ProcessEntry32.th32ProcessID; + CDMhd:=GetWindowFromID(processID); + Affiche('CDM rail processID='+IntToSTR(ProcessID)+' handle='+IntToSTR(CDMhd),clOrange); + Result:=true; + Break; + end; + until (Process32Next(hSnapShot,ProcessEntry32)=false); + CloseHandle(hSnapShot); +end; + +procedure SendKey(Wnd,VK : Cardinal; Ctrl,Alt,Shift : Boolean); +var + MC,MA,MS : Boolean; +begin + // Met la fenetre de destination en arrière + //ShowWindow(Wnd,SW_SHOW); + //SetForegroundWindow(Wnd); + + //if VK=ord('\') then Vk:=58; // * + + + // Etats des touches spéciales + MC:=Hi(GetAsyncKeyState(VK_CONTROL))>127; + MA:=Hi(GetAsyncKeyState(VK_MENU))>127; + MS:=Hi(GetAsyncKeyState(VK_SHIFT))>127; + + // Simulation des touches de contrôle + if Ctrl<>MC then keybd_event(VK_CONTROL,0,Byte(MC)*KEYEVENTF_KEYUP,0); + if Alt<>MA then keybd_event(VK_MENU,0,Byte(MA)*KEYEVENTF_KEYUP,0); + if Shift<>MS then keybd_event(VK_SHIFT,0,Byte(MS)*KEYEVENTF_KEYUP,0); + + // Appui sur les touches + keybd_event(VK,0,0,0); + keybd_event(VK,0,KEYEVENTF_KEYUP,0); + +// keybd_event(MapVirtualKeyA(VK,0),0,0,0); +// keybd_event(MapVirtualKeyA(VK,0),0,KEYEVENTF_KEYUP,0); + + // Release modifier keys if necessary + if Ctrl<>MC then keybd_event(VK_CONTROL,0,Byte(Ctrl)*KEYEVENTF_KEYUP,0); + if Alt<>MA then keybd_event(VK_MENU,0,Byte(Alt)*KEYEVENTF_KEYUP,0); + if Shift<>MS then keybd_event(VK_SHIFT,0,Byte(Shift)*KEYEVENTF_KEYUP,0); +end; + +// conversion d'une chaine standard en chaîne VK (virtual key) pour envoyer des évènements clavier +// 112=F1 .. 135=F20 136 à 143 rien 145 à 159 : spécifique ou non utilisé +// $A0 .. $B0 : contrôles curseur +// $BA : spécifique au pays +// $6A à $6F * + espace - . / +// BB à BE + - . attention la description diffère +function convert_VK(LAY : string) : string; +var i : integer; + s : string; +begin + s:=''; + for i:=1 to Length(Lay) do + begin + case Lay[i] of + '0' : s:=s+#96 ; + '1' : s:=s+'a'; + '2' : s:=s+'b'; + '3' : s:=s+'c'; + '4' : s:=s+'d'; + '5' : s:=s+'e'; + '6' : s:=s+'f'; + '7' : s:=s+'g'; + '8' : s:=s+'h'; + '9' : s:=s+'i'; + '*' : s:=s+#$6a; + '+' : s:=s+#$6b; + // ' ' : s:=s+#$6c; + '-' : s:=s+#$6d; + '.' : s:=s+#$6e; + '/' : s:=s+#$6f; + '_' : s:=s+'{8}'; + // '\' : s:=s+#$e2; + 'a'..'z' : s:=s+Upcase(lay[i]); + ' ','A'..'Z',#8..#$D : s:=s+lay[i]; + else Affiche('Erreur de conversion VK : '+lay,clred); + end; + end; + convert_VK:=s; +end; + +// en sortie si Lance_CDM=true, il a été lancé, sinon il était déja lancé. +function Lance_CDM : boolean; +var i : integer; + s : string; +begin + s:='CDR'; + if (ProcessRunning(s)) then begin Lance_CDM:=false;exit;end; + + Affiche('Lancement de CDM',clyellow); + if ShellExecute(Formprinc.Handle, + 'open',PChar('C:\Program Files (x86)\CDM-Rail\cdr.exe'), + //'open',Pchar('notepad'), + Pchar(''), // paramètre + PChar('C:\Program Files (x86)\CDM-Rail\') // répertoire + ,SW_SHOWNORMAL)<=32 then + begin + ShowMessage(SysErrorMessage(GetLastError)); + Lance_CDM:=false;exit; + end + + else + begin + Sleep(1000); + // démarre le serveur IP : Alt C , return 2 fois + SendKey(CDMHd,ord('C'),false,true,false); + SendKey(CDMHd,VK_RETURN,false,false,false); + SendKey(CDMHd,VK_RETURN,false,false,false); + Sleep(100); + Application.ProcessMessages; + + // Ouvre le fichier réseau : Alt F , Return, O, return + SendKey(CDMHd,ord('F'),false,true,false); + SendKey(CDMHd,VK_RETURN,false,false,false); + SendKey(CDMHd,ord('O'),false,false,false); + SendKey(CDMHd,VK_RETURN,false,false,false); + Sleep(200); // attendre ouverture de la fenêtre + Application.ProcessMessages; + + // ouvre le fichier réseau + + Affiche('Ouvre '+Lay,clyellow); + s:=convert_VK(LAY); + Sleep(100); + for i:=1 to length(s) do + SendKey(CDMHd,ord(s[i]),false,false,false); + SendKey(CDMHd,VK_return,false,false,false); + Sleep(2000); + Application.ProcessMessages; + + // Serveur d'interface + if ServeurInterfaceCDM>0 then + begin + // ALT I 2 fois , Return + SendKey(CDMHd,ord('I'),false,true,false); // Avec Alt + SendKey(CDMHd,ord('I'),false,false,false); // Sans Alt + SendKey(CDMHd,VK_RETURN,false,false,false); // Ouvre le menu + SendKey(CDMHd,VK_RETURN,false,false,false); // Affiche le serveur d'interfaces + Sleep(100); + + // descendre le curseur n fois + for i:=1 to ServeurInterfaceCDM-1 do + begin + SendKey(CDMHd,VK_DOWN,false,false,false); + end; + // 2x TAB pour pointer sur OK + SendKey(CDMHd,VK_TAB,false,false,false); + SendKey(CDMHd,VK_TAB,false,false,false); + SendKey(CDMHd,VK_RETURN,false,false,false); + Sleep(100); + + // Rétrosignalisation + if (ServeurInterfaceCDM=1) or (ServeurInterfaceCDM=7) then + begin + for i:=1 to ServeurRetroCDM-1 do + begin + SendKey(CDMHd,VK_DOWN,false,false,false); + end; + // 3x TAB pour pointer sur OK + SendKey(CDMHd,VK_TAB,false,false,false); + SendKey(CDMHd,VK_TAB,false,false,false); + SendKey(CDMHd,VK_TAB,false,false,false); + SendKey(CDMHd,VK_RETURN,false,false,false); + Sleep(100); + end; + end; + Sleep(100); + SendKey(CDMHd,VK_return,false,false,false); // renvoyer un CR + Lance_CDM:=true; + Application.ProcessMessages; + end; +end; + procedure TFormPrinc.FormCreate(Sender: TObject); var i,j : integer; s,s2,Url,LocalFile : string; trouve,AvecMaj : Boolean; V_utile : real; + CibleHandle : Thandle; begin //AvecMaj:=false; TraceSign:=True; @@ -6673,9 +6891,9 @@ begin TempoAct:=0; DebugOuv:=True; - AvecInit:=true; //&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& - AvecTCO:=false; - + AvecInit:=false; //&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& + Diffusion:=true; + // créée la fenetre vérification de version FormVersion:=TformVersion.Create(Self); @@ -6686,24 +6904,16 @@ begin AffMem:=true; N_routes:=0; N_trains:=0; - // Train[1].index:=0; + ButtonAffTCO.visible:=AvecTCO; + // Train[1].index:=0; - // lecture fichier de configuration config.cfg + // lecture fichier de configuration client_GL.cfg et config.cfg lit_config; + + // lancer CDM rail si on le demande + if LanceCDM then Lance_CDM; + - // TCO - if avectco then - begin - //créée la fenêtre TCO - FormTCO:=TformTCO.Create(Self); - FormTCO.show; - //construit_TCO; - //affiche_TCO; - //Formprinc.Hide; - end; - - - // tenter la liaison vers CDM rail ou vers la centrale Lenz //Affiche('Test présence CDM',clYellow); connecte_CDM; @@ -6771,38 +6981,21 @@ begin N_Event_tick:=0 ; // dernier index NombreImages:=0; + // TCO + if avectco then + begin + //créée la fenêtre TCO + FormTCO:=TformTCO.Create(Self); + FormTCO.show; + end; + //essai - //maj_feu(201); -// formdebug.Show; - //AfficheDet:=true; - //NivDebug:=3; - //Aiguille_deviee(462); - //aiguillageB[1].Position:=1; - //i:=suivant_alg3(553,1,1,3,1); - //Affichedebug(intToSTr(i),clred); - //Affiche(IntToSTR(calcul_zones_det(522,514)),clyellow); - - //i:=detecteur_suivant_El(514,1,518,1); // donne l'élément suivant de AdrPrec à AdrFonc et dans Bis si c'est un aig bis - //i:=etat_signal_suivant(1001,1); - // Affiche(IntToSTR(detecteur_suivant(25,2,529,1)),clyellow); - //i:=Aiguille_deviee(176); - //signal_direction(372); - //FormDebug.show; - //test_memoire_zones(218); - //Det_Adj(520); - //Affiche(' Adj1='+intToStr(Adj1)+' Adj2='+intToStr(Adj2),clyellow); - //trace:=true; - //TraceListe:=true; - //interprete_reponse(#$FF+#$FD+#$46+#$43+#$40+#$41+#$40+#$40+#$49+#$4D); Affiche('Fin des initialisations',clyellow); - - //Menu_interface(valide); - //s:=#$f0; - //s:=checksum(s); - //envoi(s); - //id_cdm:='01'; - //envoie_fonction_CDM(0,1,'train'); - //i:=ShellExecute(handle,PChar('open'),PChar('C:\Program Files (x86)\CDM-Rail\cdr.exe'),nil,nil,SW_SHOWNORMAL); + LabelEtat.Caption:=' '; + + // SendMessage(CDMHd, WM_MENUCOMMAND,9001,0); + // SendMessage(CDMHd, WM_COMMAND,9001,9001); + // SendMessage(CDMHd, WM_MENUSELECT,9001,9001); end; @@ -6810,7 +7003,6 @@ end; procedure TFormPrinc.MSCommUSBLenzComm(Sender: TObject); var i : integer; begin - //trace:=true; if MSCommUSBLenz.commEvent=comEvReceive then begin TpsRecuCom:=0; @@ -6833,6 +7025,9 @@ begin portCommOuvert:=false; ClientSocketCDM.close; ClientSocketLenz.close; + if TCO_modifie then + if MessageDlg('Le TCO a été modifié. Voulez vous le sauvegarder ?',mtConfirmation,[mbYes,mbNo],0)=mrYes then + sauve_fichier_tco; end; @@ -6860,11 +7055,9 @@ begin end; - - // timer à 100 ms procedure TFormPrinc.Timer1Timer(Sender: TObject); -var index,aspect,i,a,x,y,adresse,TailleX,TailleY : integer; +var index,aspect,i,a,x,y,adresse,TailleX,TailleY,orientation : integer; imageFeu : Timage; frx,fry : real; s : string; @@ -6911,40 +7104,51 @@ begin end; end; + // feux du TCO if avecTCO then begin + // parcourir les feux du TCO for i:=1 to NbFeuTCO do begin - x:=(FeuTCO[i].x-1)*LargeurCell; - y:=(FeuTCO[i].y-1)*HauteurCell; adresse:=FeuTCO[i].adresse; if adresse<>0 then begin - index:=index_feu(adresse); - if index<>0 then + a:=EtatsignalCplx[adresse]; // a = état binaire du feu + if TestBit(a,jaune_cli) or TestBit(a,ral_60) or + TestBit(a,rappel_60) or testBit(a,semaphore_cli) or + testBit(a,vert_cli) or testbit(a,blanc_cli) then begin - aspect:=feux[index].aspect; - case aspect of - 2 : ImageFeu:=Formprinc.Image2feux; - 3 : ImageFeu:=Formprinc.Image3feux; - 4 : ImageFeu:=Formprinc.Image4feux; - 5 : ImageFeu:=Formprinc.Image5feux; - 7 : ImageFeu:=Formprinc.Image7feux; - 9 : ImageFeu:=Formprinc.Image9feux; - else ImageFeu:=Formprinc.Image3feux; - end; - - TailleY:=ImageFeu.picture.BitMap.Height; // taille du feu d'origine (verticale) - TailleX:=ImageFeu.picture.BitMap.Width; - frx:=LargeurCell/TailleX; - frY:=2*HauteurCell/TailleY; - - a:=EtatsignalCplx[adresse]; // a = état binaire du feu - if TestBit(a,jaune_cli) or TestBit(a,ral_60) or - TestBit(a,rappel_60) or testBit(a,semaphore_cli) or - testBit(a,vert_cli) or testbit(a,blanc_cli) then - Dessine_feu_mx(PCanvasTCO,x,y,frx,fry,adresse,1); - end; + aspect:=feuTCO[i].aspect; + case aspect of + 2 : ImageFeu:=Formprinc.Image2feux; + 3 : ImageFeu:=Formprinc.Image3feux; + 4 : ImageFeu:=Formprinc.Image4feux; + 5 : ImageFeu:=Formprinc.Image5feux; + 7 : ImageFeu:=Formprinc.Image7feux; + 9 : ImageFeu:=Formprinc.Image9feux; + else ImageFeu:=Formprinc.Image3feux; + end; + + x:=(FeuTCO[i].x-1)*LargeurCell; // coordonnées XY et feu + y:=(FeuTCO[i].y-1)*HauteurCell; + TailleY:=ImageFeu.picture.BitMap.Height; // taille du feu d'origine (verticale) + TailleX:=ImageFeu.picture.BitMap.Width; + Orientation:=FeuTCO[i].FeuOriente; + // réduction variable en fonction de la taille des cellules + calcul_reduction(frx,fry,round(TailleX*LargeurCell/ZoomMax),round(tailleY*HauteurCell/ZoomMax),TailleX,TailleY); + + // décalage en X pour mettre la tete du feu alignée sur le bord droit de la cellule pour les feux tournés à 90G + if orientation=2 then + begin + if aspect=9 then x:=x+round(10*frX); + if aspect=7 then x:=x+round(10*frX); + if aspect=5 then begin x:=x+round(10*frX);y:=y+HauteurCell-round(tailleX*frY); end; + if aspect=4 then begin x:=x+round(10*frX);y:=y+HauteurCell-round(tailleX*frY); end; + if aspect=3 then begin x:=x+round(10*frX);y:=y+HauteurCell-round(tailleX*frY); end; + if aspect=2 then begin x:=x+round(10*frX);y:=y+HauteurCell-round(tailleX*frY); end; + end; + Dessine_feu_mx(PCanvasTCO,x,y,frx,fry,adresse,orientation); + end; end; end; end; @@ -7014,6 +7218,7 @@ begin if AffTickSimu then Affiche('Simulation '+intToSTR(I_simule)+' Tick='+IntToSTR(tick)+' det='+intToSTR(Tablo_simule[i_simule].detecteur)+'='+IntToSTR(Tablo_simule[i_simule].etat),Cyan); Event_Detecteur(Tablo_simule[i_simule].detecteur, Tablo_simule[i_simule].etat=1); // créer évt détecteur end; + // evt aiguillage ? if Tablo_simule[i_simule].aiguillage<>0 then begin @@ -7252,7 +7457,10 @@ begin if model<>0 then begin s:='Aiguillage '+IntToSTR(i)+' : '+intToSTR(aiguillage[i].position); - if aiguillage[i].position=1 then s:=s+' (dévié)' else s:=s+' (droit)'; + if aiguillage[i].position=const_devie then s:=s+' (dévié)' ; + if aiguillage[i].position=const_droit then s:=s+' (droit)'; + if aiguillage[i].position=9 then s:=s+' inconnue'; + objet:=aiguillage[i].objet; if objet<>0 then s:=s+' objet='+intToSTR(objet); if model=4 then // aig triple @@ -7578,8 +7786,8 @@ begin Affiche('Version 1.43 : Correction erreur gestion sémaphore',clLime); Affiche('Version 1.44 : Gestion trains avec voitures éclairées',clLime); Affiche('Version 1.45 : Rejette les n° d''objets supérieurs aiguillages à la même adresse',clLime); - Affiche('Version 1.5 : Nouvel algorithme de suivi des trains',clLime); - + Affiche('Version 1.5 : Nouvel algorithme de suivi des trains - Gestion des feux provenant de voies en buttoir',clLime); + Affiche('Version 1.6 : Implémentation du TCO. Ouverture de CDM rail au démarrage avec LAY à la demande',clLime); end; procedure TFormPrinc.ClientSocketLenzDisconnect(Sender: TObject; @@ -7667,6 +7875,7 @@ begin end; +// lit un fichier de CV vers un accessoire procedure Lire_fichier_CV; var s: string; fte : textfile; @@ -7687,7 +7896,6 @@ begin while not(eof(fte)) do begin readln(fte,s); - // s:=' 35 63'; val(s,cv,erreur); if (cv<>0) then @@ -7793,15 +8001,6 @@ begin formconfig.close; end; -procedure TFormPrinc.Button2Click(Sender: TObject); -var i : integer; -begin - //traceliste:=true; - //NivDebug:=3; - i:=test_route_valide(519,517,518); - Affiche(IntToSTR(i),clOrange); -end; - procedure TFormPrinc.Codificationdesactionneurs1Click(Sender: TObject); var i,adr,etatAct,v,aO,aF : integer; @@ -7878,11 +8077,30 @@ begin end; + + +procedure TFormPrinc.ButtonAffTCOClick(Sender: TObject); +var hd : THandle; +begin + //SetactiveWindow(formTCO.handle); + //formTCO.BringToFront; + hd:=formTCO.handle; + + // SetForeGroundWindow(hd) ; + ShowWindow(hd,SW_Show); + // sendMessage(hd,wm_syscommand,sc_minimize,0); +end; + + +procedure TFormPrinc.ButtonLanceCDMClick(Sender: TObject); +begin + if Lance_CDM then connecte_CDM; +end; + begin - end. diff --git a/UnitSimule.dcu b/UnitSimule.dcu index 6cf92ce..2a537a7 100644 Binary files a/UnitSimule.dcu and b/UnitSimule.dcu differ diff --git a/UnitTCO.dcu b/UnitTCO.dcu index 01fff9a..44a5bf9 100644 Binary files a/UnitTCO.dcu and b/UnitTCO.dcu differ diff --git a/UnitTCO.dfm b/UnitTCO.dfm index 31925d8..6a2cf58 100644 --- a/UnitTCO.dfm +++ b/UnitTCO.dfm @@ -1,7 +1,7 @@ object FormTCO: TFormTCO - Left = 251 - Top = 202 - Width = 928 + Left = 232 + Top = 211 + Width = 992 Height = 681 VertScrollBar.Visible = False Caption = 'FormTCO' @@ -15,47 +15,50 @@ object FormTCO: TFormTCO KeyPreview = True OldCreateOrder = False OnActivate = FormActivate + OnClose = FormClose OnCreate = FormCreate OnDockOver = FormDockOver OnKeyDown = FormKeyDown + DesignSize = ( + 976 + 643) PixelsPerInch = 96 TextHeight = 13 object LabelX: TLabel - Left = 32 - Top = 14 - Width = 53 - Height = 19 - Caption = 'LabelX' + Left = 72 + Top = 6 + Width = 7 + Height = 16 + Caption = '0' Font.Charset = ANSI_CHARSET Font.Color = clWindowText - Font.Height = -16 + Font.Height = -13 Font.Name = 'Arial' Font.Style = [fsBold] ParentFont = False end object Label2: TLabel Left = 16 - Top = 16 - Width = 13 - Height = 13 - Caption = 'X=' - end - object Label3: TLabel - Left = 104 - Top = 16 - Width = 13 - Height = 13 - Caption = 'X=' + Top = 6 + Width = 49 + Height = 16 + Caption = 'Cellule' + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -13 + Font.Name = 'MS Sans Serif' + Font.Style = [fsBold] + ParentFont = False end object LabelY: TLabel - Left = 120 - Top = 14 - Width = 51 - Height = 19 - Caption = 'Label1' + Left = 96 + Top = 6 + Width = 7 + Height = 16 + Caption = '0' Font.Charset = ANSI_CHARSET Font.Color = clWindowText - Font.Height = -16 + Font.Height = -13 Font.Name = 'Arial' Font.Style = [fsBold] ParentFont = False @@ -63,392 +66,64 @@ object FormTCO: TFormTCO object Label1: TLabel Left = 776 Top = 8 - Width = 32 + Width = 3 Height = 13 - Caption = 'Label1' - end - object Label4: TLabel - Left = 24 - Top = 480 - Width = 175 - Height = 25 - Caption = 'Adresse de l'#39#233'l'#233'ment: ' - Font.Charset = ANSI_CHARSET - Font.Color = clWindowText - Font.Height = -21 - Font.Name = 'Arial Narrow' - Font.Style = [] - ParentFont = False - end - object Label5: TLabel - Left = 24 - Top = 520 - Width = 150 - Height = 25 - Caption = 'Type de l'#39#233'l'#233'ment: ' - Font.Charset = ANSI_CHARSET - Font.Color = clWindowText - Font.Height = -21 - Font.Name = 'Arial Narrow' - Font.Style = [] - ParentFont = False - end - object ImagePalette1: TImage - Left = 440 - Top = 480 - Width = 41 - Height = 41 - DragMode = dmAutomatic - OnEndDrag = ImagePalette1EndDrag - OnMouseDown = ImagePalette1MouseDown - end - object ImagePalette2: TImage - Left = 512 - Top = 480 - Width = 41 - Height = 41 - DragMode = dmAutomatic - OnEndDrag = ImagePalette2EndDrag - OnMouseDown = ImagePalette2MouseDown - end - object ImagePalette3: TImage - Left = 584 - Top = 480 - Width = 41 - Height = 41 - DragMode = dmAutomatic - OnEndDrag = ImagePalette3EndDrag - OnMouseDown = ImagePalette3MouseDown - end - object ImagePalette4: TImage - Left = 656 - Top = 480 - Width = 41 - Height = 41 - DragMode = dmAutomatic - OnEndDrag = ImagePalette4EndDrag - OnMouseDown = ImagePalette4MouseDown - end - object ImagePaletteDroit: TImage - Left = 440 - Top = 528 - Width = 41 - Height = 41 - DragMode = dmAutomatic - OnEndDrag = ImagePaletteDroitEndDrag - OnMouseDown = ImagePaletteDroitMouseDown - end - object ImageSupG: TImage - Left = 512 - Top = 528 - Width = 41 - Height = 41 - DragMode = dmAutomatic - OnEndDrag = ImageSupGEndDrag - OnMouseDown = ImageSupGMouseDown - end - object ImageSupD: TImage - Left = 584 - Top = 528 - Width = 41 - Height = 41 - DragMode = dmAutomatic - OnEndDrag = ImageSupDEndDrag - OnMouseDown = ImageSupDMouseDown - end - object ImageInfD: TImage - Left = 656 - Top = 528 - Width = 41 - Height = 41 - DragMode = dmAutomatic - OnEndDrag = ImageInfDEndDrag - OnMouseDown = ImageInfDMouseDown - end - object ImageInfG: TImage - Left = 728 - Top = 528 - Width = 41 - Height = 41 - DragMode = dmAutomatic - OnEndDrag = ImageInfGEndDrag - OnMouseDown = ImageInfGMouseDown - end - object Label6: TLabel - Left = 424 - Top = 488 - Width = 9 - Height = 19 - Caption = '1' - Font.Charset = ANSI_CHARSET - Font.Color = clWindowText - Font.Height = -16 - Font.Name = 'Arial' - Font.Style = [fsBold] - ParentFont = False - end - object Label7: TLabel - Left = 496 - Top = 488 - Width = 9 - Height = 19 - Caption = '2' - Font.Charset = ANSI_CHARSET - Font.Color = clWindowText - Font.Height = -16 - Font.Name = 'Arial' - Font.Style = [fsBold] - ParentFont = False - end - object Label8: TLabel - Left = 568 - Top = 488 - Width = 9 - Height = 19 - Caption = '3' - Font.Charset = ANSI_CHARSET - Font.Color = clWindowText - Font.Height = -16 - Font.Name = 'Arial' - Font.Style = [fsBold] - ParentFont = False - end - object Label9: TLabel - Left = 640 - Top = 488 - Width = 9 - Height = 19 - Caption = '4' - Font.Charset = ANSI_CHARSET - Font.Color = clWindowText - Font.Height = -16 - Font.Name = 'Arial' - Font.Style = [fsBold] - ParentFont = False - end - object Label10: TLabel - Left = 424 - Top = 536 - Width = 9 - Height = 19 - Caption = '5' - Font.Charset = ANSI_CHARSET - Font.Color = clWindowText - Font.Height = -16 - Font.Name = 'Arial' - Font.Style = [fsBold] - ParentFont = False - end - object Label11: TLabel - Left = 496 - Top = 536 - Width = 9 - Height = 19 - Caption = '6' - Font.Charset = ANSI_CHARSET - Font.Color = clWindowText - Font.Height = -16 - Font.Name = 'Arial' - Font.Style = [fsBold] - ParentFont = False - end - object Label12: TLabel - Left = 568 - Top = 536 - Width = 9 - Height = 19 - Caption = '7' - Font.Charset = ANSI_CHARSET - Font.Color = clWindowText - Font.Height = -16 - Font.Name = 'Arial' - Font.Style = [fsBold] - ParentFont = False - end - object Label13: TLabel - Left = 640 - Top = 536 - Width = 9 - Height = 19 - Caption = '8' - Font.Charset = ANSI_CHARSET - Font.Color = clWindowText - Font.Height = -16 - Font.Name = 'Arial' - Font.Style = [fsBold] - ParentFont = False - end - object Label14: TLabel - Left = 712 - Top = 536 - Width = 9 - Height = 19 - Caption = '9' - Font.Charset = ANSI_CHARSET - Font.Color = clWindowText - Font.Height = -16 - Font.Name = 'Arial' - Font.Style = [fsBold] - ParentFont = False - end - object Label15: TLabel - Left = 24 - Top = 560 - Width = 158 - Height = 25 - Caption = 'Image de l'#39#233'l'#233'ment: ' - Font.Charset = ANSI_CHARSET - Font.Color = clWindowText - Font.Height = -21 - Font.Name = 'Arial Narrow' - Font.Style = [] - ParentFont = False - end - object ImageDiag1: TImage - Left = 440 - Top = 576 - Width = 41 - Height = 41 - DragMode = dmAutomatic - OnEndDrag = ImageDiag1EndDrag - OnMouseDown = ImageDiag1MouseDown - end - object Label16: TLabel - Left = 416 - Top = 584 - Width = 18 - Height = 19 - Caption = '10' - Font.Charset = ANSI_CHARSET - Font.Color = clWindowText - Font.Height = -16 - Font.Name = 'Arial' - Font.Style = [fsBold] - ParentFont = False - end - object ImageDiag2: TImage - Left = 512 - Top = 576 - Width = 41 - Height = 41 - DragMode = dmAutomatic - OnEndDrag = ImageDiag2EndDrag - OnMouseDown = ImageDiag2MouseDown - end - object Label17: TLabel - Left = 488 - Top = 584 - Width = 17 - Height = 19 - Caption = '11' - Font.Charset = ANSI_CHARSET - Font.Color = clWindowText - Font.Height = -16 - Font.Name = 'Arial' - Font.Style = [fsBold] - ParentFont = False - end - object ImageFeu: TImage - Left = 584 - Top = 576 - Width = 25 - Height = 41 - DragMode = dmAutomatic - Stretch = True - OnEndDrag = ImageFeuEndDrag - OnMouseDown = ImageFeuMouseDown - end - object Label18: TLabel - Left = 560 - Top = 584 - Width = 18 - Height = 19 - Caption = '12' - Font.Charset = ANSI_CHARSET - Font.Color = clWindowText - Font.Height = -16 - Font.Name = 'Arial' - Font.Style = [fsBold] - ParentFont = False - end - object ImageTemp: TImage - Left = 304 - Top = 504 - Width = 97 - Height = 97 + Caption = '-' end object SourisX: TLabel Left = 232 Top = 8 - Width = 36 + Width = 6 Height = 13 - Caption = 'SourisX' + Caption = '0' end object SourisY: TLabel Left = 288 Top = 8 - Width = 36 + Width = 6 Height = 13 - Caption = 'SourisY' + Caption = '0' end - object EditAdrElement: TEdit - Left = 200 - Top = 480 - Width = 89 - Height = 33 - Font.Charset = ANSI_CHARSET + object ImageTemp: TImage + Left = 16 + Top = 464 + Width = 97 + Height = 97 + end + object Label19: TLabel + Left = 912 + Top = 456 + Width = 32 + Height = 13 + Anchors = [akRight, akBottom] + Caption = 'Zoom' + Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText - Font.Height = -21 - Font.Name = 'Arial Narrow' - Font.Style = [] + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [fsBold] ParentFont = False - TabOrder = 1 - OnChange = EditAdrElementChange - end - object EditTypeElement: TEdit - Left = 200 - Top = 520 - Width = 89 - Height = 33 - Font.Charset = ANSI_CHARSET - Font.Color = clWindowText - Font.Height = -21 - Font.Name = 'Arial Narrow' - Font.Style = [] - ParentFont = False - ReadOnly = True - TabOrder = 0 - end - object ButtonSauveTCO: TButton - Left = 784 - Top = 480 - Width = 91 - Height = 33 - Caption = 'Sauvegarder TCO' - TabOrder = 2 - WordWrap = True - OnClick = ButtonSauveTCOClick - end - object ButtonRedessine: TButton - Left = 784 - Top = 520 - Width = 89 - Height = 33 - Caption = 'Redessine' - TabOrder = 3 - OnClick = ButtonRedessineClick end object ScrollBox: TScrollBox - Left = 16 - Top = 40 - Width = 873 - Height = 425 - TabOrder = 4 + Left = 8 + Top = 32 + Width = 889 + Height = 433 + HorzScrollBar.Smooth = True + HorzScrollBar.Tracking = True + VertScrollBar.Smooth = True + VertScrollBar.Tracking = True + Anchors = [akLeft, akTop, akRight, akBottom] + TabOrder = 0 + DesignSize = ( + 885 + 429) object ImageTCO: TImage Left = 0 Top = 0 Width = 865 - Height = 409 + Height = 361 + Anchors = [akLeft, akTop, akRight, akBottom] PopupMenu = PopupMenu1 OnClick = ImageTCOClick OnContextPopup = ImageTCOContextPopup @@ -458,50 +133,544 @@ object FormTCO: TFormTCO OnMouseUp = ImageTCOMouseUp end end - object EditTypeImage: TEdit - Left = 200 - Top = 560 - Width = 89 - Height = 33 + object TrackBarZoom: TTrackBar + Left = 912 + Top = 40 + Width = 41 + Height = 409 + Anchors = [akTop, akRight, akBottom] + Max = 50 + Min = 20 + Orientation = trVertical + Position = 20 + TabOrder = 1 + TickMarks = tmTopLeft + OnChange = TrackBarZoomChange + end + object Panel1: TPanel + Left = 8 + Top = 472 + Width = 953 + Height = 153 + Anchors = [akLeft, akRight, akBottom] Font.Charset = ANSI_CHARSET - Font.Color = clWindowText - Font.Height = -21 - Font.Name = 'Arial Narrow' + Font.Color = clBlue + Font.Height = -9 + Font.Name = 'MS Sans Serif' Font.Style = [] ParentFont = False - TabOrder = 5 - OnKeyPress = EditTypeImageKeyPress - end - object Button1: TButton - Left = 784 - Top = 560 - Width = 89 - Height = 25 - Caption = 'Simu det 1' - TabOrder = 6 - OnClick = Button1Click - end - object Button2: TButton - Left = 784 - Top = 592 - Width = 89 - Height = 25 - Caption = 'Simu Det 0' - TabOrder = 7 - OnClick = Button2Click - end - object ButtonConfigTCO: TButton - Left = 576 - Top = 8 - Width = 113 - Height = 25 - Caption = 'Configuration TCO' - TabOrder = 8 - OnClick = ButtonConfigTCOClick + TabOrder = 2 + object Label4: TLabel + Left = 8 + Top = 8 + Width = 137 + Height = 20 + Caption = 'Adresse de l'#39#233'l'#233'ment: ' + Font.Charset = ANSI_CHARSET + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'Arial Narrow' + Font.Style = [] + ParentFont = False + end + object Label5: TLabel + Left = 8 + Top = 32 + Width = 116 + Height = 20 + Caption = 'Type de l'#39#233'l'#233'ment: ' + Font.Charset = ANSI_CHARSET + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'Arial Narrow' + Font.Style = [] + ParentFont = False + end + object Label15: TLabel + Left = 8 + Top = 56 + Width = 123 + Height = 20 + Caption = 'Image de l'#39#233'l'#233'ment: ' + Font.Charset = ANSI_CHARSET + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'Arial Narrow' + Font.Style = [] + ParentFont = False + end + object ImagePalette5: TImage + Left = 504 + Top = 8 + Width = 41 + Height = 41 + DragMode = dmAutomatic + OnEndDrag = ImagePalette5EndDrag + OnMouseDown = ImagePalette5MouseDown + end + object Label6: TLabel + Left = 200 + Top = 22 + Width = 9 + Height = 19 + Caption = '1' + Font.Charset = ANSI_CHARSET + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'Arial' + Font.Style = [fsBold] + ParentFont = False + end + object ImagePalette2: TImage + Left = 288 + Top = 8 + Width = 41 + Height = 41 + DragMode = dmAutomatic + OnEndDrag = ImagePalette2EndDrag + OnMouseDown = ImagePalette2MouseDown + end + object Label7: TLabel + Left = 272 + Top = 22 + Width = 9 + Height = 19 + Caption = '2' + Font.Charset = ANSI_CHARSET + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'Arial' + Font.Style = [fsBold] + ParentFont = False + end + object Label10: TLabel + Left = 488 + Top = 22 + Width = 9 + Height = 19 + Caption = '5' + Font.Charset = ANSI_CHARSET + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'Arial' + Font.Style = [fsBold] + ParentFont = False + end + object ImagePaletteDroit: TImage + Left = 216 + Top = 8 + Width = 41 + Height = 41 + DragMode = dmAutomatic + OnEndDrag = ImagePaletteDroitEndDrag + OnMouseDown = ImagePaletteDroitMouseDown + end + object ImageSupG: TImage + Left = 216 + Top = 56 + Width = 41 + Height = 41 + DragMode = dmAutomatic + OnEndDrag = ImageSupGEndDrag + OnMouseDown = ImageSupGMouseDown + end + object ImageSupD: TImage + Left = 288 + Top = 56 + Width = 41 + Height = 41 + DragMode = dmAutomatic + OnEndDrag = ImageSupDEndDrag + OnMouseDown = ImageSupDMouseDown + end + object ImageInfD: TImage + Left = 360 + Top = 56 + Width = 41 + Height = 41 + DragMode = dmAutomatic + OnEndDrag = ImageInfDEndDrag + OnMouseDown = ImageInfDMouseDown + end + object ImageInfG: TImage + Left = 432 + Top = 56 + Width = 41 + Height = 41 + DragMode = dmAutomatic + OnEndDrag = ImageInfGEndDrag + OnMouseDown = ImageInfGMouseDown + end + object Label11: TLabel + Left = 200 + Top = 70 + Width = 9 + Height = 19 + Caption = '6' + Font.Charset = ANSI_CHARSET + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'Arial' + Font.Style = [fsBold] + ParentFont = False + end + object Label12: TLabel + Left = 272 + Top = 70 + Width = 9 + Height = 19 + Caption = '7' + Font.Charset = ANSI_CHARSET + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'Arial' + Font.Style = [fsBold] + ParentFont = False + end + object Label13: TLabel + Left = 344 + Top = 70 + Width = 9 + Height = 19 + Caption = '8' + Font.Charset = ANSI_CHARSET + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'Arial' + Font.Style = [fsBold] + ParentFont = False + end + object Label14: TLabel + Left = 416 + Top = 70 + Width = 9 + Height = 19 + Caption = '9' + Font.Charset = ANSI_CHARSET + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'Arial' + Font.Style = [fsBold] + ParentFont = False + end + object ImagePalette3: TImage + Left = 360 + Top = 8 + Width = 41 + Height = 41 + DragMode = dmAutomatic + OnEndDrag = ImagePalette3EndDrag + OnMouseDown = ImagePalette3MouseDown + end + object ImagePalette4: TImage + Left = 432 + Top = 8 + Width = 41 + Height = 41 + DragMode = dmAutomatic + OnEndDrag = ImagePalette4EndDrag + OnMouseDown = ImagePalette4MouseDown + end + object Label8: TLabel + Left = 344 + Top = 22 + Width = 9 + Height = 19 + Caption = '3' + Font.Charset = ANSI_CHARSET + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'Arial' + Font.Style = [fsBold] + ParentFont = False + end + object Label9: TLabel + Left = 416 + Top = 22 + Width = 9 + Height = 19 + Caption = '4' + Font.Charset = ANSI_CHARSET + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'Arial' + Font.Style = [fsBold] + ParentFont = False + end + object ImageDiag1: TImage + Left = 216 + Top = 104 + Width = 41 + Height = 41 + DragMode = dmAutomatic + OnEndDrag = ImageDiag1EndDrag + OnMouseDown = ImageDiag1MouseDown + end + object Label16: TLabel + Left = 192 + Top = 118 + Width = 18 + Height = 19 + Caption = '10' + Font.Charset = ANSI_CHARSET + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'Arial' + Font.Style = [fsBold] + ParentFont = False + end + object ImageDiag2: TImage + Left = 288 + Top = 104 + Width = 41 + Height = 41 + DragMode = dmAutomatic + OnEndDrag = ImageDiag2EndDrag + OnMouseDown = ImageDiag2MouseDown + end + object Label17: TLabel + Left = 264 + Top = 118 + Width = 17 + Height = 19 + Caption = '11' + Font.Charset = ANSI_CHARSET + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'Arial' + Font.Style = [fsBold] + ParentFont = False + end + object ImageFeu: TImage + Left = 368 + Top = 104 + Width = 25 + Height = 41 + DragMode = dmAutomatic + Stretch = True + OnEndDrag = ImageFeuEndDrag + OnMouseDown = ImageFeuMouseDown + end + object Label18: TLabel + Left = 336 + Top = 118 + Width = 18 + Height = 19 + Caption = '30' + Font.Charset = ANSI_CHARSET + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'Arial' + Font.Style = [fsBold] + ParentFont = False + end + object ImageAig45PG_AG: TImage + Left = 576 + Top = 8 + Width = 41 + Height = 41 + DragMode = dmAutomatic + OnEndDrag = ImageAig45PG_AGEndDrag + OnMouseDown = ImageAig45PG_AGMouseDown + end + object Label20: TLabel + Left = 552 + Top = 22 + Width = 18 + Height = 19 + Caption = '12' + Font.Charset = ANSI_CHARSET + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'Arial' + Font.Style = [fsBold] + ParentFont = False + end + object Label3: TLabel + Left = 624 + Top = 22 + Width = 18 + Height = 19 + Caption = '13' + Font.Charset = ANSI_CHARSET + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'Arial' + Font.Style = [fsBold] + ParentFont = False + end + object ImageAig45PD_AD: TImage + Left = 648 + Top = 8 + Width = 41 + Height = 41 + DragMode = dmAutomatic + OnEndDrag = ImageAig45PD_ADEndDrag + OnMouseDown = ImageAig45PD_ADMouseDown + end + object Label21: TLabel + Left = 696 + Top = 22 + Width = 18 + Height = 19 + Caption = '14' + Font.Charset = ANSI_CHARSET + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'Arial' + Font.Style = [fsBold] + ParentFont = False + end + object ImageAig45PD_AG: TImage + Left = 720 + Top = 8 + Width = 41 + Height = 41 + DragMode = dmAutomatic + OnEndDrag = ImageAig45PD_AGEndDrag + OnMouseDown = ImageAig45PD_AGMouseDown + end + object Label22: TLabel + Left = 768 + Top = 22 + Width = 18 + Height = 19 + Caption = '15' + Font.Charset = ANSI_CHARSET + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'Arial' + Font.Style = [fsBold] + ParentFont = False + end + object ImageAig45PG_AD: TImage + Left = 792 + Top = 8 + Width = 41 + Height = 41 + DragMode = dmAutomatic + OnEndDrag = ImageAig45PG_ADEndDrag + OnMouseDown = ImageAig45PG_ADMouseDown + end + object Label23: TLabel + Left = 8 + Top = 85 + Width = 33 + Height = 20 + Caption = 'Texte' + Font.Charset = ANSI_CHARSET + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'Arial Narrow' + Font.Style = [] + ParentFont = False + end + object EditAdrElement: TEdit + Left = 152 + Top = 8 + Width = 33 + Height = 28 + Font.Charset = ANSI_CHARSET + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'Arial Narrow' + Font.Style = [] + ParentFont = False + TabOrder = 0 + OnChange = EditAdrElementChange + end + object EditTypeElement: TEdit + Left = 152 + Top = 32 + Width = 33 + Height = 33 + Font.Charset = ANSI_CHARSET + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'Arial Narrow' + Font.Style = [] + ParentFont = False + ReadOnly = True + TabOrder = 1 + end + object EditTypeImage: TEdit + Left = 152 + Top = 56 + Width = 33 + Height = 28 + Font.Charset = ANSI_CHARSET + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'Arial Narrow' + Font.Style = [] + ParentFont = False + TabOrder = 2 + OnKeyPress = EditTypeImageKeyPress + end + object ButtonSauveTCO: TButton + Left = 854 + Top = 48 + Width = 91 + Height = 33 + Caption = 'Sauvegarder TCO' + TabOrder = 3 + WordWrap = True + OnClick = ButtonSauveTCOClick + end + object ButtonRedessine: TButton + Left = 856 + Top = 8 + Width = 89 + Height = 33 + Caption = 'Redessine' + TabOrder = 4 + OnClick = ButtonRedessineClick + end + object Button1: TButton + Left = 672 + Top = 88 + Width = 89 + Height = 25 + Caption = 'Simu det 1' + TabOrder = 5 + OnClick = Button1Click + end + object Button2: TButton + Left = 672 + Top = 120 + Width = 89 + Height = 25 + Caption = 'Simu Det 0' + TabOrder = 6 + OnClick = Button2Click + end + object ButtonConfigTCO: TButton + Left = 832 + Top = 88 + Width = 113 + Height = 33 + Caption = 'Configuration TCO' + TabOrder = 7 + OnClick = ButtonConfigTCOClick + end + object EditTexte: TEdit + Left = 96 + Top = 88 + Width = 89 + Height = 21 + TabOrder = 8 + OnChange = EditTexteChange + end end object PopupMenu1: TPopupMenu - Left = 352 - Top = 472 + Left = 360 + object Annulercouper: TMenuItem + Caption = 'Annuler couper' + OnClick = AnnulercouperClick + end + object N5: TMenuItem + Caption = '-' + end object MenuCouper: TMenuItem Caption = 'Couper' OnClick = MenuCouperClick @@ -517,61 +686,17 @@ object FormTCO: TFormTCO object N1: TMenuItem Caption = '-' end - object Insrer1: TMenuItem - Caption = 'Ins'#233'rer' - object aiguillageG_PG: TMenuItem - Caption = 'Aiguillage gauche ; pointe '#224' gauche' - OnClick = aiguillageG_PGClick - end - object aiguillageD_PD: TMenuItem - Caption = 'Aiguillage droit ; pointe '#224' droite' - OnClick = aiguillageD_PDClick - end - object N2: TMenuItem - Caption = '-' - end - object Aiguillagegauchepointedroite1: TMenuItem - Caption = 'Aiguillage gauche ; pointe '#224' droite' - OnClick = Aiguillagegauchepointedroite1Click - end - object Aiguillagedroitpointegauche1: TMenuItem - Caption = 'Aiguillage droit : pointe '#224' gauche' - OnClick = Aiguillagedroitpointegauche1Click - end - object N3: TMenuItem - Caption = '-' - end - object Elmentdroit1: TMenuItem - Caption = 'El'#233'ment droit' - OnClick = Elmentdroit1Click - end - object N4: TMenuItem - Caption = '-' - end - object Courbegaucheversdroite1: TMenuItem - Caption = 'Courbe infD' - OnClick = Courbegaucheversdroite1Click - end - object Courbedroiteversgauche1: TMenuItem - Caption = 'Courbe infG' - OnClick = Courbedroiteversgauche1Click - end - object CourbeSupD1: TMenuItem - Caption = 'Courbe SupD' - OnClick = CourbeSupD1Click - end - object CourbeSupG1: TMenuItem - Caption = 'Courbe SupG' - OnClick = CourbeSupG1Click - end - end object Tourner90G: TMenuItem - Caption = 'Tourner 90'#176' '#224' gauche' + Caption = 'Positionner 90'#176' '#224' gauche' OnClick = Tourner90GClick end object Tourner90D: TMenuItem - Caption = 'Tourner 90'#176' '#224' droite' + Caption = 'Positionner 90'#176' '#224' droite' OnClick = Tourner90DClick end + object Pos_vert: TMenuItem + Caption = 'Positionner verticalement' + OnClick = Pos_vertClick + end end end diff --git a/UnitTCO.pas b/UnitTCO.pas index 31daf62..e40b909 100644 --- a/UnitTCO.pas +++ b/UnitTCO.pas @@ -4,98 +4,103 @@ interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, - Dialogs, Grids , UnitPrinc, StdCtrls, ExtCtrls, Menus, UnitPilote ; + Dialogs, Grids , UnitPrinc, StdCtrls, ExtCtrls, Menus, UnitPilote, + ComCtrls ; type TFormTCO = class(TForm) LabelX: TLabel; Label2: TLabel; - Label3: TLabel; LabelY: TLabel; PopupMenu1: TPopupMenu; MenuCouper: TMenuItem; N1: TMenuItem; - Insrer1: TMenuItem; - aiguillageG_PG: TMenuItem; Label1: TLabel; - aiguillageD_PD: TMenuItem; - N2: TMenuItem; - Aiguillagegauchepointedroite1: TMenuItem; - Aiguillagedroitpointegauche1: TMenuItem; - N3: TMenuItem; - Elmentdroit1: TMenuItem; - N4: TMenuItem; - Courbegaucheversdroite1: TMenuItem; - Courbedroiteversgauche1: TMenuItem; - CourbeSupD1: TMenuItem; - CourbeSupG1: TMenuItem; + MenuCopier: TMenuItem; + MenuColler: TMenuItem; + ScrollBox: TScrollBox; + ImageTCO: TImage; + Tourner90G: TMenuItem; + Tourner90D: TMenuItem; + SourisX: TLabel; + SourisY: TLabel; + Pos_vert: TMenuItem; + TrackBarZoom: TTrackBar; + Panel1: TPanel; Label4: TLabel; - EditAdrElement: TEdit; Label5: TLabel; + Label15: TLabel; + EditAdrElement: TEdit; EditTypeElement: TEdit; - ImagePalette1: TImage; + EditTypeImage: TEdit; + ImageTemp: TImage; + ImagePalette5: TImage; + Label6: TLabel; ImagePalette2: TImage; - ImagePalette3: TImage; - ImagePalette4: TImage; + Label7: TLabel; + Label10: TLabel; ImagePaletteDroit: TImage; ImageSupG: TImage; ImageSupD: TImage; ImageInfD: TImage; ImageInfG: TImage; - ButtonSauveTCO: TButton; - Label6: TLabel; - Label7: TLabel; - Label8: TLabel; - Label9: TLabel; - Label10: TLabel; Label11: TLabel; Label12: TLabel; Label13: TLabel; Label14: TLabel; - MenuCopier: TMenuItem; - MenuColler: TMenuItem; - ButtonRedessine: TButton; - ScrollBox: TScrollBox; - ImageTCO: TImage; - Label15: TLabel; - EditTypeImage: TEdit; - Button1: TButton; - Button2: TButton; + ImagePalette3: TImage; + ImagePalette4: TImage; + Label8: TLabel; + Label9: TLabel; ImageDiag1: TImage; Label16: TLabel; ImageDiag2: TImage; Label17: TLabel; - ButtonConfigTCO: TButton; ImageFeu: TImage; Label18: TLabel; - ImageTemp: TImage; - Tourner90G: TMenuItem; - Tourner90D: TMenuItem; - SourisX: TLabel; - SourisY: TLabel; + ButtonSauveTCO: TButton; + ButtonRedessine: TButton; + Button1: TButton; + Button2: TButton; + Label19: TLabel; + ButtonConfigTCO: TButton; + Annulercouper: TMenuItem; + N5: TMenuItem; + ImageAig45PG_AG: TImage; + Label20: TLabel; + Label3: TLabel; + ImageAig45PD_AD: TImage; + Label21: TLabel; + ImageAig45PD_AG: TImage; + Label22: TLabel; + ImageAig45PG_AD: TImage; + Label23: TLabel; + EditTexte: TEdit; procedure FormCreate(Sender: TObject); procedure ImageTCOClick(Sender: TObject); procedure FormActivate(Sender: TObject); procedure ImageTCOContextPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean); - procedure aiguillageG_PGClick(Sender: TObject); - procedure dessin_AigPG_AG(Canvas : Tcanvas;x,y : integer;couleur : Tcolor;Mode : TPenMode); - procedure dessin_AigPD_AD(Canvas : Tcanvas;x,y : integer;couleur : Tcolor;Mode : TPenMode); + procedure dessin_AigPG_AG(Canvas : Tcanvas;x,y : integer;couleur : Tcolor;Mode : TPenMode;position : integer); + procedure dessin_Aig45PG_AG(Canvas : Tcanvas;x,y : integer;couleur : Tcolor;Mode : TPenMode; position : integer); + procedure dessin_Aig45PD_AG(Canvas : Tcanvas;x,y : integer;couleur : Tcolor;Mode : TPenMode; position : integer); + procedure dessin_Aig45PD_AD(Canvas : Tcanvas;x,y : integer;couleur : Tcolor;Mode : TPenMode;position : integer); + procedure dessin_Aig45PG_AD(Canvas : Tcanvas;x,y : integer;couleur : Tcolor;Mode : TPenMode;position : integer); + procedure dessin_AigPD_AD(Canvas : Tcanvas;x,y : integer;couleur : Tcolor;Mode : TPenMode;position : integer); procedure dessin_Diag1(Canvas : Tcanvas;x,y : integer;couleur : Tcolor;Mode : TPenMode); procedure dessin_Diag2(Canvas : Tcanvas;x,y : integer;couleur : Tcolor;Mode : TPenMode); procedure dessin_infG(Canvas : Tcanvas;x,y : integer;couleur : Tcolor;Mode : TPenMode); procedure dessin_infD(Canvas : Tcanvas;x,y : integer;couleur : Tcolor;Mode : TPenMode); procedure Entoure_cell(x,y : integer); procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); - procedure aiguillageD_PDClick(Sender: TObject); - procedure Aiguillagegauchepointedroite1Click(Sender: TObject); - procedure dessin_AigG_PD(canvas : Tcanvas;X,Y : integer; couleur : Tcolor;Mode : TPenMode); +// procedure Aiguillagegauchepointedroite1Click(Sender: TObject); + procedure dessin_AigG_PD(canvas : Tcanvas;X,Y : integer; couleur : Tcolor;Mode : TPenMode;position : integer); procedure Elmentdroit1Click(Sender: TObject); procedure dessin_voie(Canvas : Tcanvas;x,y : integer;couleur : TColor;Mode : TPenMode); procedure Courbegaucheversdroite1Click(Sender: TObject); procedure Courbedroiteversgauche1Click(Sender: TObject); - procedure Aiguillagedroitpointegauche1Click(Sender: TObject); - procedure dessin_AigD_PG(Canvas : Tcanvas;x,y : integer; couleur : Tcolor;Mode : TPenMode); +// procedure Aiguillagedroitpointegauche1Click(Sender: TObject); + procedure dessin_AigD_PG(Canvas : Tcanvas;x,y : integer; couleur : Tcolor;Mode : TPenMode;position : integer ); procedure CourbeSupD1Click(Sender: TObject); procedure dessin_SupD(Canvas : Tcanvas;x,y : integer; couleur : Tcolor;Mode : TPenMode); procedure CourbeSupG1Click(Sender: TObject); @@ -103,9 +108,9 @@ type procedure ImageTCODragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure FormDockOver(Sender: TObject; Source: TDragDockObject; X,Y: Integer; State: TDragState; var Accept: Boolean); - procedure ImagePalette1MouseDown(Sender: TObject; Button: TMouseButton; + procedure ImagePalette5MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); - procedure ImagePalette1EndDrag(Sender, Target: TObject; X, Y: Integer); + procedure ImagePalette5EndDrag(Sender, Target: TObject; X, Y: Integer); procedure ImagePalette2EndDrag(Sender, Target: TObject; X, Y: Integer); procedure ImagePalette2MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); @@ -150,7 +155,7 @@ type procedure EditTypeImageKeyPress(Sender: TObject; var Key: Char); procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); - procedure Maj_TCO(Adresse : integer;etat : boolean); + procedure Maj_TCO(Adresse : integer); procedure ImageDiag1EndDrag(Sender, Target: TObject; X, Y: Integer); procedure ImageDiag1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); @@ -163,6 +168,27 @@ type Shift: TShiftState; X, Y: Integer); procedure Tourner90GClick(Sender: TObject); procedure Tourner90DClick(Sender: TObject); + procedure Pos_vertClick(Sender: TObject); + procedure TrackBarZoomChange(Sender: TObject); + procedure AnnulercouperClick(Sender: TObject); + procedure FormClose(Sender: TObject; var Action: TCloseAction); + procedure ImageAig45PG_AGEndDrag(Sender, Target: TObject; X, + Y: Integer); + procedure ImageAig45PG_AGMouseDown(Sender: TObject; + Button: TMouseButton; Shift: TShiftState; X, Y: Integer); + procedure ImageAig45PD_ADEndDrag(Sender, Target: TObject; X, + Y: Integer); + procedure ImageAig45PD_ADMouseDown(Sender: TObject; + Button: TMouseButton; Shift: TShiftState; X, Y: Integer); + procedure ImageAig45PD_AGEndDrag(Sender, Target: TObject; X, + Y: Integer); + procedure ImageAig45PD_AGMouseDown(Sender: TObject; + Button: TMouseButton; Shift: TShiftState; X, Y: Integer); + procedure ImageAig45PG_ADEndDrag(Sender, Target: TObject; X, + Y: Integer); + procedure ImageAig45PG_ADMouseDown(Sender: TObject; + Button: TMouseButton; Shift: TShiftState; X, Y: Integer); + procedure EditTexteChange(Sender: TObject); private { Déclarations privées } @@ -170,28 +196,41 @@ type { Déclarations publiques } end; - TTCO = array[1..100] of array[1..50] of record + + +const + clGrille=$404040; + ZoomMax=50; + MaxCellX=100;MaxCellY=50; + +type + + TTCO = array[1..MaxCellX] of array[1..MaxCellY] of record BType : integer ; // 1= détecteur 2= aiguillage 3=bis 4=Buttoir Adresse : integer ; // adresse du détecteur ou de l'aiguillage ou du feu - BImage : integer ; // 0=rien 1=voie 2=aiguillage gauche gauche ... 12=feu - FeuAspect : integer; // aspect du feu (2 feux...9 feux) - FeuOriente : integer ; // orientation du feu : 1 vertical en bas / 2 horizontal gauche / 3 horizontal droit + IndexFeu : integer ; // index du feu dans le tableau FeuTCO + BImage : integer ; // 0=rien 1=voie 2=aiguillage gauche gauche ... 30=feu + Texte : string[30]; + //FeuAspect : integer; // aspect du feu (2 feux...9 feux) + //FeuOriente : integer ; // orientation du feu : 1 vertical en bas / 2 horizontal gauche / 3 horizontal droit + PiedFeu : integer; // type de pied au feu end; TfeuTCO = array[1..50] of record Adresse : integer ; // adresse du feu; x,y : integer ; // coordonnées pixels FeuOriente : integer; + PiedFeu : integer; + Aspect : integer; end; -const - clGrille=$707070; + var Fond,couleurAdresse : Tcolor; FormTCO: TFormTCO; - Forminit,sourisclic,SelectionAffichee,TamponAffecte : boolean; - HtImageTCO,LargImageTCO,XclicCell,YclicCell,XminiSel,YminiSel, + Forminit,sourisclic,SelectionAffichee,TamponAffecte,entoure,Diffusion,TCO_modifie : boolean; + HtImageTCO,LargImageTCO,XclicCell,YclicCell,XminiSel,YminiSel,XCoupe,Ycoupe, XmaxiSel,YmaxiSel,AncienXMiniSel,AncienXMaxiSel ,AncienYMiniSel,AncienYMaxiSel, - Xclic,Yclic,XClicCellInserer,YClicCellInserer : integer; + Xclic,Yclic,XClicCellInserer,YClicCellInserer,Xentoure,Yentoure : integer; TamponTCO,tco : TTco ; TamponTCO_Org : record @@ -205,9 +244,12 @@ var PScrollBoxTCO : TScrollBox; PImageTCO : Timage; PImageTemp : TImage; - + frXGlob,frYGlob : real; LargeurCell,HauteurCell,NbreCellX,NbreCellY : integer ; +procedure calcul_reduction(Var frx,fry : real;DimDestX,DimDestY,DimOrgX,DimOrgY : integer); +procedure sauve_fichier_tco; + implementation uses UnitConfigTCO; @@ -219,14 +261,13 @@ uses UnitConfigTCO; procedure lire_fichier_tco; var fichier : textfile; s : string; - x,y,i,valeur,erreur : integer; + x,y,i,adresse,Aspect,valeur,erreur,FeuOriente,PiedFeu : integer; function lit_ligne : string ; var c : char; begin repeat readln(fichier,s); - s:=uppercase(s); //Affiche(s,clWhite); if length(s)>0 then c:=s[1]; until ((c<>'/') and (s<>'')) or eof(fichier) ; @@ -242,25 +283,19 @@ begin end; x:=1;y:=1;NbreCellX:=0;NbreCellY:=0;NbFeuTCO:=0; + // taille de la matrice + s:=lit_ligne; + Val(s,NbreCellX,erreur); + delete(s,1,erreur); + Val(s,NbreCellY,erreur); + + // largeur et hauteur des cellules + s:=lit_ligne; + Val(s,LargeurCell,erreur); + delete(s,1,erreur); + Val(s,HauteurCell,erreur); - //Faire une passe pour lire la taille de la matrice - while not eof(fichier) do - begin - s:=lit_ligne; - if s[1]<>'/' then - begin - inc(NbreCellY); NbreCellX:=0; - repeat - i:=pos(')',s); - if i=0 then begin closefile(fichier);exit;end; - delete(s,1,i); - inc(NbreCellX); - until s=''; - end; - end; - reset(fichier); - - // 2eme passe : lire le fichier + // lire le fichier while not eof(fichier) do begin s:=lit_ligne; @@ -271,41 +306,68 @@ begin if i=0 then begin closefile(fichier);exit;end; delete(s,i,1); + // Btype i:=pos(',',s); if i=0 then begin closefile(fichier);exit;end; val(copy(s,1,i-1),valeur,erreur);if erreur<>0 then begin closefile(fichier);exit;end; tco[x,y].BType:=valeur; delete(s,1,i); + // Adresse i:=pos(',',s); if i=0 then begin closefile(fichier);exit;end; - val(copy(s,1,i-1),valeur,erreur);if erreur<>0 then begin closefile(fichier);exit;end; - tco[x,y].adresse:=valeur; + val(copy(s,1,i-1),adresse,erreur);if erreur<>0 then begin closefile(fichier);exit;end; + tco[x,y].adresse:=adresse; delete(s,1,i); + //Bimage i:=pos(',',s); if i=0 then begin closefile(fichier);exit;end; val(copy(s,1,i-1),valeur,erreur);if erreur<>0 then begin closefile(fichier);exit;end; tco[x,y].Bimage:=valeur; delete(s,1,i); - i:=pos(')',s); + // FeuOriente (pas encore stocké) + i:=pos(',',s); if i=0 then begin closefile(fichier);exit;end; - val(copy(s,1,i-1),valeur,erreur);if erreur<>0 then begin closefile(fichier);exit;end; - tco[x,y].FeuOriente:=valeur; + val(copy(s,1,i-1),FeuOriente,erreur);if erreur<>0 then begin closefile(fichier);exit;end; delete(s,1,i); - // si c'est un feu, remplir tableau FeuTCO - if tco[x,y].Bimage=12 then + // PiedFeu (pas encore stocké) + i:=pos(',',s); + if i=0 then begin closefile(fichier);exit;end; + val(copy(s,1,i-1),PiedFeu,erreur);if erreur<>0 then begin closefile(fichier);exit;end; + delete(s,1,i); + + // si c'est un feu, remplir tableau feux + if tco[x,y].Bimage=30 then begin inc(NbFeuTCO); // Affiche(intToSTR(tco[x,y].Adresse),clyellow); - FeuTCO[NbFeuTCO].Adresse:=tco[x,y].Adresse; - FeuTCO[NbFeuTCO].FeuOriente:=tco[x,y].FeuOriente; + i:=index_feu(adresse); + if i<>0 then + begin + aspect:=Feux[i].aspect; + // Affiche('Feu '+IntToSTR(Adresse)+' aspect='+intToSTR(aspect),clyellow); + Feux[i].indexTCO:=NbFeuTCO; + FeuTCO[NbFeuTCO].Aspect:=aspect; + end; + FeuTCO[NbFeuTCO].Adresse:=adresse; + FeuTCO[NbFeuTCO].FeuOriente:=FeuOriente; FeuTCO[NbFeuTCO].x:=x; FeuTCO[NbFeuTCO].y:=y; + FeuTCO[NbFeuTCO].PiedFeu:=PiedFeu; + + TCO[x,y].IndexFeu:=NbFeuTCO; + TCO[x,y].PiedFeu:=PiedFeu; end; + i:=pos(')',s); + if i<>1 then + tco[x,y].Texte:=copy(s,1,i-1) + else + tco[x,y].Texte:=''; + delete(s,1,i); inc(x); until s=''; @@ -320,11 +382,18 @@ end; procedure sauve_fichier_tco; var fichier : textfile; s : string; - x,y,erreur : integer; + x,y,i,erreur : integer; begin AssignFile(fichier,'tco.cfg'); rewrite(fichier); writeln(fichier,'/type(0=rien 1=voie/détecteur 2=aig 3=aigBis , adresse , image=1 à 10 ,orientation'); + writeln(fichier,'/ Taille de la matrice x,y'); + writeln(fichier,IntToSTR(NbreCellX)+','+intToSTR(NbreCellY)); + writeln(fichier,'/ Largeur et hauteur des cellules en pixels'); + writeln(fichier,'/ type,adresse,image,Orientation du feu, pied du feu'); + + writeln(fichier,IntToSTR(LargeurCell)+','+intToSTR(HauteurCell)); + writeln(fichier,'/Dalle TCO'); for y:=1 to NbreCellY do begin @@ -332,7 +401,15 @@ begin for x:=1 to NbreCellX do begin s:=s+'('+IntToSTR(TCO[x,y].BType)+','+Format('%.*d',[3,TCO[x,y].Adresse])+','+ - IntToSTR(TCO[x,y].BImage)+','+IntToSTR(TCO[x,y].FeuOriente)+')'; + IntToSTR(TCO[x,y].BImage)+','; + if TCO[x,y].BImage=30 then + begin + i:=TCO[x,y].IndexFeu; + s:=s+IntToSTR(FeuTCO[i].FeuOriente)+','+IntToSTR(TCO[x,y].PiedFeu)+','; + end + else s:=s+'0,0,'; + // texte + s:=s+TCO[x,y].Texte+')'; end; writeln(fichier,s); end; @@ -349,6 +426,8 @@ begin With PCanvasTCO do begin pen.color:=ClGrille; + Brush.Color:=Fond; + pen.mode:=PmCopy; // lignes verticales for x:=1 to NbreCellX do begin @@ -363,7 +442,7 @@ begin end; end; -// élément de voie horizontale +// élément de voie horizontale Element 1 procedure TFormTCO.dessin_voie(Canvas : Tcanvas;x,y : integer;couleur : TColor;Mode : TPenMode); var Adr, x0,y0,x1,y1,x2,y2,x3,y3,x4,y4,jy1,jy2 : integer; r : Trect; @@ -387,19 +466,22 @@ begin Brush.Color:=clWhite; pen.color:=couleur; Pen.Mode:=Mode; - jy1:=y0+(HauteurCell div 2)-6; // pos Y de la bande sup - jy2:=y0+(HauteurCell div 2)+6; // pos Y de la bande inf + jy1:=y0+(HauteurCell div 2)-round(6*frYGlob); // pos Y de la bande sup + jy2:=y0+(HauteurCell div 2)+round(6*frYGlob); // pos Y de la bande inf r:=Rect(x0,jy1,x0+LargeurCell,jy2); FillRect(r); + couleur:=clblue; end; end; Brush.Color:=couleur; pen.color:=couleur; - jy1:=y0+(HauteurCell div 2)-3; // pos Y de la bande sup - jy2:=y0+(HauteurCell div 2)+3; // pos Y de la bande inf + 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); + + end; end; @@ -418,14 +500,10 @@ begin r:=Rect(x0,y0,x0+LargeurCell,y0+HauteurCell); FillRect(r); - x1:=x0; - y1:=y0+hauteurCell-3; - x2:=x0+largeurCell-3; - y2:=y0; - x3:=x0+largeurCell; - y3:=y0+4; - x4:=x0+4; - y4:=y0+hauteurCell; + 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; Brush.Color:=couleur; pen.color:=couleur; @@ -449,14 +527,10 @@ begin r:=Rect(x0,y0,x0+LargeurCell,y0+HauteurCell); FillRect(r); - x1:=x0+3; - y1:=y0; - x2:=x0+largeurCell; - y2:=y0+HauteurCell-3; - x3:=x0+largeurCell-4; - y3:=y0+HauteurCell; - x4:=x0; - y4:=y0+4; + 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); Brush.Color:=couleur; pen.color:=couleur; @@ -465,7 +539,7 @@ begin end; end; -// courbe bas gauche vers droit +// courbe bas gauche vers droit Elément 9 procedure TFormTCO.dessin_infG(Canvas : Tcanvas;x,y : integer;couleur : Tcolor;Mode : TPenMode); var jy1,jy2,x0,y0,i,x1,y1,x2,y2,x3,y3,x4,y4 : integer; r : Trect; @@ -483,25 +557,21 @@ begin pen.color:=Couleur; Pen.Mode:=Mode; - jy1:=y0+(HauteurCell div 2)-3; // pos Y de la bande sup - jy2:=y0+(HauteurCell div 2)+3; // pos Y de la bande inf + 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-3; - x2:=x0+(LargeurCell div 2) -0; - y2:=jy1; - x3:=x0+(LargeurCell div 2) +2; - y3:=jy2; - x4:=x0+3; - y4:=y0+HauteurCell; - Polygon([point(x1-2,y1+2),Point(x2,y2),Point(x3,y3),Point(x4-2,y4+2)]); + 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)]); end; end; -// courbe: droit vers bas -\ +// courbe: droit vers bas -\ Element 8 procedure TFormTCO.dessin_infD(Canvas : Tcanvas;x,y : integer;couleur : Tcolor;Mode : TPenMode); var jy1,jy2,x0,y0,i,x1,y1,x2,y2,x3,y3,x4,y4 : integer; r : Trect; @@ -519,25 +589,23 @@ begin Pen.Mode:=Mode; pen.color:=Couleur; - jy1:=y0+(HauteurCell div 2)-3; // pos Y de la bande sup - jy2:=y0+(HauteurCell div 2)+3; // pos Y de la bande inf + 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-3; - x3:=x0+LargeurCell -2; - y3:=y0+HauteurCell; - x4:=x0+(LargeurCell div 2); - y4:=jy2; + 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)]); end; end; +// Element 7 procedure TformTCO.dessin_SupD(Canvas : Tcanvas;x,y : integer; couleur : Tcolor;Mode : TPenMode); var x0,y0,x1,y1,x2,y2,x3,y3,x4,y4,jy1,jy2 : integer; r : Trect; @@ -551,28 +619,24 @@ begin FillRect(r); Brush.COlor:=Couleur; - pen.color:=Couleur; + pen.color:=couleur; Pen.Mode:=Mode; - jy1:=y0+(HauteurCell div 2)-3; // pos Y de la bande sup - jy2:=y0+(HauteurCell div 2)+3; // pos Y de la bande inf - r:=Rect(x0,jy1,x0+(LargeurCell div 2),jy2); + 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); // brush.color:=clblue; - x1:=x0+(LargeurCell div 2); - y1:=jy1; - x2:=x0+LargeurCell-2; - y2:=y0; - x3:=x0+LargeurCell; - y3:=y0+2; - x4:=x0+(LargeurCell div 2); - y4:=jy2-2; - Polygon([point(x1-2,y1+2),Point(x2,y2),Point(x3,y3),Point(x4,y4)]); + 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)]); end; end; -// coin supérieur gauche +// coin supérieur gauche (Element 6) procedure TformTCO.dessin_SupG(Canvas : Tcanvas;x,y : integer; couleur : Tcolor;Mode : TPenMode); var x0,y0,x1,y1,x2,y2,x3,y3,x4,y4,jy1,jy2 : integer; r : Trect; @@ -589,26 +653,235 @@ begin pen.color:=Couleur; Pen.Mode:=Mode; - jy1:=y0+(HauteurCell div 2)-3; // pos Y de la bande sup - jy2:=y0+(HauteurCell div 2)+3; // pos Y de la bande inf + 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); - y1:=jy2-2; - x2:=x0; - y2:=y0; - x3:=x0+3; - y3:=y0; - x4:=x0+(LargeurCell div 2); - y4:=jy1; + 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)]); end; end; -// aiguillage pointe à gauche, aiguillage gauche -procedure TFormTCO.dessin_AigPG_AG(Canvas : Tcanvas;x,y : integer;couleur : Tcolor;Mode : TPenMode); +// Element 15 +procedure TFormTCO.dessin_Aig45PG_AD(Canvas : Tcanvas;x,y : integer;couleur : Tcolor;Mode : TPenMode;position : integer); +var x0,y0,x1,y1,x2,y2,x3,y3,x4,y4,jy1,jy2 : 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); + + 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; + + Brush.Color:=couleur; + pen.color:=couleur; + PolyGon([point(x1,y1),point(x2,y2),point(x3,y3),point(x4,y4)]); + + 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); + + // aiguillage dévié + 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; + + // aiguillage droit + if position=const_Droit then + begin + 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(6*frxGlob);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 14 +procedure TFormTCO.dessin_Aig45PD_AG(Canvas : Tcanvas;x,y : integer;couleur : Tcolor;Mode : TPenMode;position : integer); +var x0,y0,x1,y1,x2,y2,x3,y3,x4,y4,jy1,jy2 : 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); + + 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); + + Brush.Color:=couleur; + pen.color:=couleur; + PolyGon([point(x1,y1),point(x2,y2),point(x3,y3),point(x4,y4)]); + + 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); + + // aiguillage dévié + if position=const_Devie then + begin + 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; + + // aiguillage droit + if position=const_Droit then + begin + 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; + pen.color:=fond; + Brush.Color:=fond; + Polygon([point(x1,y1),Point(x2,y2),Point(x3,y3),Point(x4,y4)]); + end; + end; +end; + +// Elément 13 +procedure TFormTCO.dessin_Aig45PD_AD(Canvas : Tcanvas;x,y : integer;couleur : Tcolor;Mode : TPenMode;position : integer); +var x0,y0,x1,y1,x2,y2,x3,y3,x4,y4,jy1,jy2 : 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); + + 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; + + Brush.Color:=couleur; + pen.color:=couleur; + PolyGon([point(x1,y1),point(x2,y2),point(x3,y3),point(x4,y4)]); + + 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); + + // aiguillage dévié + if position=const_Devie then + begin + 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; + + // aiguillage droit + if position=const_Droit then + begin + x1:=x0+round(18*frXGlob);y1:=jy1; + x2:=x1+round(5*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)]); + end; + end; +end; + +// Element 12 aiguillage pointe 45°G vers droit +procedure TFormTCO.dessin_Aig45PG_AG(Canvas : Tcanvas;x,y : integer;couleur : Tcolor;Mode : TPenMode;position : integer); +var x0,y0,x1,y1,x2,y2,x3,y3,x4,y4,jy1,jy2 : 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); + + 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); + + Brush.Color:=couleur; + pen.color:=couleur; + PolyGon([point(x1,y1),point(x2,y2),point(x3,y3),point(x4,y4)]); + + 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); + + // aiguillage dévié + 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; + + // aiguillage droit + if position=const_Droit then + begin + 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; + pen.color:=fond; + Brush.COlor:=fond; + Polygon([point(x1,y1),Point(x2,y2),Point(x3,y3),Point(x4,y4)]); + end; + end; +end; + +// aiguillage pointe à gauche, aiguillage gauche Element 3 +procedure TFormTCO.dessin_AigPG_AG(Canvas : Tcanvas;x,y : integer;couleur : Tcolor;Mode : TPenMode;position : integer); var x0,y0,x1,y1,x2,y2,x3,y3,x4,y4,jy1,jy2 : integer; r : Trect; s : string; @@ -625,28 +898,47 @@ begin Brush.Color:=couleur; pen.color:=couleur; Pen.Mode:=Mode; - jy1:=y0+(HauteurCell div 2)-3; // pos Y de la bande sup - jy2:=y0+(HauteurCell div 2)+3; // pos Y de la bande inf + 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); //brush.color:=clblue; - x1:=x0+(largeurCell div 2); - y1:=jy1; - x2:=x0+largeurCell-3; - y2:=y0; - x3:=x0+largeurCell; - y3:=y0+3; - x4:=x0+(largeurCell div 2)+7; - y4:=jy1; - Polygon([point(x1,y1),Point(x2,y2),Point(x3+2,y3-2),Point(x4+2,y4-2)]); + x1:=x0+(largeurCell div 2)+round(1*frXGlob); y1:=jy1; + x2:=x0+largeurCell-round(3*frXGlob); y2:=y0; + x3:=x0+largeurCell; y3:=y0+round(3*frYGlob); + x4:=x0+(largeurCell div 2)+round(1*frXGlob);y4:=jy2-round(1*frYGlob); + Polygon([point(x1,y1),Point(x2,y2),Point(x3,y3),Point(x4,y4)]); + + // aiguillage dévié + 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; + if position=const_Droit then + begin + // 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; -// aiguillage pointe à droite, aiguillage droit -procedure TFormTCO.dessin_AigPD_AD(Canvas : Tcanvas;x,y : integer;couleur : Tcolor;Mode : TPenMode); +// aiguillage pointe à droite, aiguillage droit Element 5 +procedure TFormTCO.dessin_AigPD_AD(Canvas : Tcanvas;x,y : integer;couleur : Tcolor;Mode : TPenMode;position : integer); var x0,y0,x1,y1,x2,y2,x3,y3,x4,y4,jy1,jy2 : integer; r : Trect; s : string; @@ -664,22 +956,47 @@ begin Pen.Mode:=Mode; pen.color:=couleur; - jy1:=y0+(HauteurCell div 2)-3; // pos Y de la bande sup - jy2:=y0+(HauteurCell div 2)+3; // pos Y de la bande inf + 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 r:=Rect(x0,jy1,x0+LargeurCell,jy2); //FillRect(r); Rectangle(r); //brush.color:=clblue; x1:=x0+(largeurCell div 2); y1:=jy1; - x2:=x0+3; y2:=y0; - x3:=x0; y3:=y0+3; - x4:=x0+(largeurCell div 2); y4:=jy2-1; - Polygon([point(x1,y1),Point(x2,y2),Point(x3,y3),Point(x4-1,y4-1)]); + 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); + Polygon([point(x1,y1),Point(x2,y2),Point(x3,y3),Point(x4,y4)]); + + // aiguillage dévié + 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; + + // aiguillage droit + if position=const_Droit then + begin + x1:=x4-10;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; -procedure TformTCO.dessin_AigG_PD(canvas : Tcanvas;x,y : integer; couleur : Tcolor;Mode : TPenMode); +// element 2 +procedure TformTCO.dessin_AigG_PD(canvas : Tcanvas;x,y : integer; couleur : Tcolor;Mode : TPenMode; position : integer); var x0,y0,x1,y1,x2,y2,x3,y3,x4,y4,jy1,jy2 : integer; r : Trect; s : string; @@ -698,22 +1015,45 @@ begin pen.color:=couleur; // bande horizontale - jy1:=y0+(HauteurCell div 2)-3; // pos Y de la bande sup - jy2:=y0+(HauteurCell div 2)+3; // pos Y de la bande inf + 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); // déviation - x1:=x0+(largeurCell div 2); y1:=jy1+1; - x2:=x0;y2:=y0+HauteurCell-2; - x3:=x0+1;y3:=y0+HauteurCell; - x4:=x1;y4:=jy2; - Polygon([point(x1,y1),Point(x2,y2),Point(x3,y3),Point(x4-1,y4-1)]); + x1:=x0+(largeurCell div 2); y1:=jy1+round(1*frYGlob); + x2:=x0-round(1*FrXGlob);y2:=y0+HauteurCell-round(2*FrYGlob); + x3:=x0+round(2*FrXGlob);y3:=y0+HauteurCell; + x4:=x1+round(1*FrXGlob);y4:=jy2; + Polygon([point(x1,y1),Point(x2,y2),Point(x3,y3),Point(x4,y4)]); + + // aiguillage dévié + 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; + if position=const_Droit then + begin + // aiguillage droit + x1:=x1+3;y1:=jy2; + x2:=x1-10;y2:=y1; + x3:=x2-5;y3:=y2+3; + x4:=x1-5;y4:=y3; + pen.color:=fond; + Brush.COlor:=fond; + Polygon([point(x1,y1),Point(x2,y2),Point(x3,y3),Point(x4,y4)]); + end; end; end; - -procedure TformTCO.dessin_AigD_PG(Canvas : Tcanvas;x,y : integer; couleur : Tcolor;Mode : TPenMode); +// Element 4 +procedure TformTCO.dessin_AigD_PG(Canvas : Tcanvas;x,y : integer; couleur : Tcolor;Mode : TPenMode;position : integer); var x0,y0,x1,y1,x2,y2,x3,y3,x4,y4,jy1,jy2 : integer; r : Trect; s : string; @@ -732,92 +1072,103 @@ begin pen.color:=couleur; // bande horizontale - jy1:=y0+(HauteurCell div 2)-3; // pos Y de la bande sup - jy2:=y0+(HauteurCell div 2)+3; // pos Y de la bande inf + 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); // déviation - x1:=x0+(largeurCell div 2); y1:=jy1+1; - x2:=x0+largeurCell;y2:=y0+HauteurCell-2; - x3:=x0+largeurCell-3;y3:=y0+HauteurCell; - x4:=x0+(largeurCell div 2);y4:=jy2; - Polygon([point(x1,y1),Point(x2,y2),Point(x3,y3),Point(x4-1,y4-1)]); + 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); + Polygon([point(x1,y1),Point(x2,y2),Point(x3,y3),Point(x4,y4)]); + + // aiguillage dévié + 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; + + if position=const_Droit then + begin + // aiguillage droit + 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; -// Affiche dans le TCO en x,y un Feu à 90° d'après l'image transmise -// x y en coordonnées grille (cellule) -procedure Feu_90G(ImageSource : TImage;x,y : integer); -var p : array[0..2] of TPoint; - x0,y0,HtFeu,LgFeu : integer; +// calcul des facteurs de réductions X et Y pour l'adapter à l'image de destination +procedure calcul_reduction(Var frx,fry : real;DimDestX,DimDestY,DimOrgX,DimOrgY : integer); begin - x0:=(x-2)*LargeurCell; - y0:=(y-1)*HauteurCell; - HtFeu:=ImageSource.Picture.Height; - lgFeu:=ImageSource.Picture.Width; - // Affiche('Taille X feu_90G='+IntToSTR(lgFeu),clLime); - //PImageTCO.Picture.Bitmap.TransparentMode:=tmFixed; // tmAuto; - //PImageTCO.Picture.Bitmap.TransparentColor:=clBlue; - //PImageTCO.Transparent:=true; + frX:=DimDestX/DimOrgX; + frY:=DimDestY/DimOrgY; +end; + +// Affiche dans le TCO en x,y un Feu à 90° d'après l'image transmise +// x y en coordonnées pixels +procedure Feu_90G(ImageSource : TImage;x,y : integer;FrX,FrY : real); +var p : array[0..2] of TPoint; + TailleY,TailleX : integer; +begin + TailleY:=ImageSource.Picture.Height; + TailleX:=ImageSource.Picture.Width; + //offset:=2*largeurCell-TailleX; + // Affiche(intToSTR(offset),clyellow); + // copie à 90°G sans mise à l'échelle dans l'image provisoire - p[0].X:=HtFeu; //90; + p[0].X:=TailleY; //90; p[0].Y:=0; //0; - p[1].X:=HtFeu; //90; - p[1].Y:=LgFeu; //49; + p[1].X:=TailleY; //90; + p[1].Y:=TailleX; //49; p[2].X:=0; //0; p[2].Y:=0; //0; - PlgBlt(PImageTemp.Canvas.Handle,p,ImageSource.Canvas.Handle,0,0,lgFeu,HtFeu,0,0,0); - PImageTemp.Picture.Bitmap.Modified:=True; - //PlgBlt(PImageTemp.Canvas.Handle,p,formprinc.Image5feux.Canvas.Handle,0,0,49,90,0,0,0); - // et copier l'image tournée sur le TCO - //StretchBlt(PcanvasTCO.Handle,x0,y0,LargeurCell*2,HauteurCell, - // PImageTemp.Canvas.Handle,0,0,HtFeu,LgFeu,srccopy); - TransparentBlt(PcanvasTCO.Handle,x0,y0,LargeurCell*2,HauteurCell, - PImageTemp.Canvas.Handle,0,0,HtFeu,LgFeu,clBlue); // clblue est la couleur de transparence + // copie l'image du feu depuis imagesource vers image temporaire à la même échelle mais retournée à 90° + PlgBlt(PImageTemp.Canvas.Handle,p,ImageSource.Canvas.Handle,0,0,TailleX,TailleY,0,0,0); + + // copie l'image du feu retournée depuis image temporaire vers tco avec une réduction en mode transparennt + TransparentBlt(PcanvasTCO.Handle,x,y,round(TailleY*FrY),round(TailleX*FrX), // destination + PImageTemp.Canvas.Handle,0,0,TailleY,TailleX,clBlue); // source - clblue est la couleur de transparence PImageTCO.Picture.Bitmap.Modified:=True; // rafraichit l'affichage sinon le stretchblt n'apparaît pas. end; // copie de l'image du feu à 90° dans le canvas source et le tourne de 90° et le met dans l'image temporaire -procedure Feu_90D(ImageSource : TImage;x,y : integer); +procedure Feu_90D(ImageSource : TImage;x,y : integer ; FrX,FrY : real); var p : array[0..2] of TPoint; - x0,y0,HtFeu,LgFeu : integer; + x0,y0,TailleY,TailleX : integer; begin - x0:=(x-1)*LargeurCell; - y0:=(y-1)*HauteurCell; - HtFeu:=ImageSource.Picture.Height; - lgFeu:=ImageSource.Picture.Width; + TailleY:=ImageSource.Picture.Height; + TailleX:=ImageSource.Picture.Width; + // copie à 90°D dans l'image provisoire p[0].X:=0; - p[0].Y:=LgFeu; //49; + p[0].Y:=TailleX; //49; p[1].X:=0; p[1].Y:=0; - p[2].X:=HtFeu; //90; - p[2].Y:=LgFeu; //49; - PlgBlt(PImageTemp.Canvas.Handle,p,ImageSource.Canvas.Handle,0,0,LgFeu,HtFeu,0,0,0); - PImageTemp.Picture.Bitmap.Modified:=True; + p[2].X:=TailleY; //90; + p[2].Y:=TailleX; //49; + // copie l'image du feu depuis imagesource vers image temporaire à la même échelle mais retournée à 90° + PlgBlt(PImageTemp.Canvas.Handle,p,ImageSource.Canvas.Handle,0,0,TailleX,TailleY,0,0,0); + // et copier l'image avec mise à l'échelle tournée sur le TCO - TransparentBlt(PcanvasTCO.Handle,x0,y0,LargeurCell*2,HauteurCell, - PImageTemp.Canvas.Handle,0,0,HtFeu,LgFeu,clBlue); + TransparentBlt(PcanvasTCO.Handle,x,y,round(tailleY*FrY),round(tailleX*FrX), + PImageTemp.Canvas.Handle,0,0,TailleY,TailleX,clBlue); PImageTCO.Picture.Bitmap.Modified:=True; // rafraichit l'affichage sinon le stretchblt n'apparaît pas. end; - // copie de l'image du feu à 180° depuis le canvas source et le met dans l'image temporaire -procedure Feu_180(CanvasSource : TCanvas); -var src,dest : Trect; -begin - dest:=bounds(0, 0, 49, 90); - src:=rect(0, 0, 49, 90); // V flip - - // dest:=bounds(0, 0, image1.Picture.Width, image1.Picture.Height); - //src:=rect(0, image1.Picture.Height-1, image1.Picture.Width-1, 0); // Vertical flip - - //src:=rect(image1.Picture.Width-1, 0, 0, image1.Picture.Height-1); // Horizontal flip - //src:=rect(image1.Picture.Width-1, image1.Picture.Height-1, 0, 0); // Both flip - PimageTemp.Picture.Bitmap.Canvas.StretchDraw(dest,Formprinc.Image9feux.Picture.Graphic); - PImageTemp.Picture.Bitmap.Modified:=True; -end; // renvoie un pointeur vers l'image du feu suivant l'aspect du feu de adresse // ne marche pas @@ -829,6 +1180,7 @@ begin i:=Index_feu(adresse); aspect:=feux[i].aspect; + pim:=nil; case aspect of 2 : Pim:=Formprinc.Image2feux; 3 : Pim:=Formprinc.Image3feux; @@ -841,7 +1193,6 @@ begin PointeurImage:=Pim; end; -// provisoire procedure cercle(ACanvas : Tcanvas;x,y,rayon : integer;couleur : Tcolor); begin with PCanvasTCO do @@ -851,23 +1202,270 @@ with PCanvasTCO do end; end; +procedure affiche_pied2G_90G(x,y : integer;FrX,frY : real); +var x1,y1 : integer; + ech : real; +begin + ech:=frY;frY:=frX;FrX:=ech; + with PcanvasTCO do + begin + 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) ); + LineTo( x+round((x1-7)*frX),y+round((y1+35)*frY) ); + + moveTo( x+round((x1)*frX),y+round((y1+1)*frY) ); + LineTo( x+round((x1-6)*frX),y+round((y1+1)*frY) ); + LineTo( x+round((x1-6)*frX),y+round((y1+35)*frY) ); + end; +end; + +procedure affiche_pied2G_90D(x,y : integer;FrX,frY : real); +var x1,y1 : integer; + ech : real; +begin + ech:=frY;frY:=frX;FrX:=ech; + with PcanvasTCO do + begin + Pen.Color:=clOrange; + x1:=35;y1:=12; + moveTo( x+round((x1)*frX),y+round(y1*frY) ); + LineTo( x+round((x1+7)*frX),y+round((y1+0)*frY) ); + LineTo( x+round((x1+7)*frX),y+round((y1-35)*fry) ); + + moveTo( x+round((x1)*frX),y+round((y1+1)*frY) ); + LineTo( x+round((x1+6)*frX),y+round((y1+1)*frY) ); + LineTo( x+round((x1+6)*frX),y+round((y1-35)*fry) ); + end; +end; + +procedure affiche_pied3G_90D(x,y : integer;FrX,frY : real); +var x1,y1 : integer; + ech : real; +begin + ech:=frY;frY:=frX;FrX:=ech; + with PcanvasTCO do + begin + 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) ); + LineTo( x+round((x1+7)*frX),y+round((y1-35)*fry) ); + + moveTo( x+round((x1)*frX),y+round((y1+1)*frY) ); + LineTo( x+round((x1+6)*frX),y+round((y1+1)*frY) ); + LineTo( x+round((x1+6)*frX),y+round((y1-35)*fry) ); + end; +end; + +procedure affiche_pied3G_90G(x,y : integer;FrX,frY : real); +var x1,y1 : integer; + ech : real; +begin + ech:=frY;frY:=frX;FrX:=ech; + with PcanvasTCO do + begin + 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) ); + LineTo( x+round((x1-7)*frX),y+round((y1+35)*frY) ); + + moveTo( x+round((x1)*frX),y+round((y1+1)*frY) ); + LineTo( x+round((x1-6)*frX),y+round((y1+1)*frY) ); + LineTo( x+round((x1-6)*frX),y+round((y1+35)*frY) ); + end; +end; + +procedure affiche_pied4G_90G(x,y : integer;FrX,frY : real); +var x1,y1 : integer; +begin + with PcanvasTCO do + begin + 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) ); + LineTo( x+round((x1-7)*frX),y+round((y1+35)*frY) ); + + moveTo( x+round((x1)*frX),y+round((y1+1)*frY) ); + LineTo( x+round((x1-6)*frX),y+round((y1+1)*frY) ); + LineTo( x+round((x1-6)*frX),y+round((y1+35)*frY) ); + end; +end; + +procedure affiche_pied4G_90D(x,y : integer;FrX,frY : real); +var x1,y1 : integer; + ech : real; +begin + ech:=frY;frY:=frX;FrX:=ech; + with PcanvasTCO do + begin + Pen.Color:=clOrange; + x1:=55;y1:=12; + moveTo( x+round(x1*frX),y+round(y1*frY) ); + LineTo( x+round((x1+7)*frX),y+round((y1+0)*frY) ); + LineTo( x+round((x1+7)*frX),y+round((y1-35)*fry) ); + + moveTo( x+round((x1)*frX),y+round((y1+1)*frY) ); + LineTo( x+round((x1+6)*frX),y+round((y1+1)*frY) ); + LineTo( x+round((x1+6)*frX),y+round((y1-35)*fry) ); + end; +end; + +procedure affiche_pied5G_90D(x,y : integer;FrX,frY : real); +var x1,y1 : integer; + ech : real; +begin + ech:=frY;frY:=frX;FrX:=ech; + with PcanvasTCO do + begin + Pen.Color:=clOrange; + x1:=66;y1:=12; + moveTo( x+round((x1)*frX),y+round(y1*frY) ); + LineTo( x+round((x1+7)*frX),y+round((y1+0)*frY) ); + LineTo( x+round((x1+7)*frX),y+round((y1-35)*fry) ); + + moveTo( x+round((x1)*frX),y+round((y1+1)*frY) ); + LineTo( x+round((x1+6)*frX),y+round((y1+1)*frY) ); + LineTo( x+round((x1+6)*frX),y+round((y1-35)*fry) ); + end; +end; + +procedure affiche_pied5G_90G(x,y : integer;FrX,frY : real); +var x1,y1 : integer; + ech : real; +begin + ech:=frY;frY:=frX;FrX:=ech; + with PcanvasTCO do + begin + 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) ); + LineTo( x+round((x1-7)*frX),y+round((y1+35)*frY) ); + + moveTo( x+round((x1)*frX),y+round((y1+1)*frY) ); + LineTo( x+round((x1-6)*frX),y+round((y1+1)*frY) ); + LineTo( x+round((x1-6)*frX),y+round((y1+35)*frY) ); + end; +end; + +procedure affiche_pied7G_90D(x,y : integer;FrX,frY : real); +var x1,y1 : integer; + ech : real; +begin + ech:=frY;frY:=frX;FrX:=ech; + with PcanvasTCO do + begin + Pen.Color:=clOrange; + x1:=75;y1:=38; + moveTo( x+round((x1)*frX),y+round(y1*frY) ); + LineTo( x+round((x1+7)*frX),y+round((y1+0)*frY) ); + LineTo( x+round((x1+7)*frX),y+round((y1-60)*fry) ); + + moveTo( x+round((x1)*frX),y+round((y1+1)*frY) ); + LineTo( x+round((x1+6)*frX),y+round((y1+1)*frY) ); + LineTo( x+round((x1+6)*frX),y+round((y1-60)*fry) ); + end; +end; + +procedure affiche_pied7G_90G(x,y : integer;FrX,frY : real); +var x1,y1 : integer; + ech : real; +begin + ech:=frY;frY:=frX;FrX:=ech; + with PcanvasTCO do + begin + 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) ); + LineTo( x+round((x1-7)*frX),y+round((y1+70-12)*frY) ); + + moveTo( x+round((x1)*frX),y+round((y1+1)*frY) ); + LineTo( x+round((x1-6)*frX),y+round((y1+1)*frY) ); + LineTo( x+round((x1-6)*frX),y+round((y1+70-13)*frY) ); + end; +end; + +procedure affiche_pied9G_90D(x,y : integer;FrX,frY : real); +var x1,y1 : integer; + var ech : real; +begin + ech:=frY;frY:=frX;FrX:=ech; + with PcanvasTCO do + begin + 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) ); + LineTo( x+round((x1+7)*frX),y+round((y1-60)*fry)); + + moveTo( x+round((x1)*frX),y+round((y1+1)*frY) ); + LineTo( x+round((x1+6)*frX),y+round((y1+1)*frY) ); + LineTo( x+round((x1+6)*frX),y+round((y1-60)*fry) ); + end; +end; + +procedure affiche_pied9G_90G(x,y : integer;FrX,frY : real); +var x1,y1 : integer; + ech : real; +begin + ech:=frY;frY:=frX;FrX:=ech; + with PcanvasTCO do + begin + 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) ); + LineTo( x+round((x1-7)*frX),y+round((y1+70-12)*frY) ); + + moveTo( x+round((x1)*frX),y+round((y1+1)*frY) ); + LineTo( x+round((x1-6)*frX),y+round((y1+1)*frY) ); + LineTo( x+round((x1-6)*frX),y+round((y1+70-13)*frY) ); + end; +end; + +procedure affiche_pied_VerticalG(x,y : integer;FrX,frY : real); +var x1,y1 : integer; +begin + with PcanvasTCO do + begin + 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) ); + LineTo( x+round((x1+50-12)*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) ); + LineTo( x+round((x1+50-12)*frX),y+round((y1+8)*frY) ); + + end; +end; + // Dessine un feu dans le canvas en x,y , dont l'adresse se trouve à la cellule x,y procedure dessin_feu(CanvasDest : Tcanvas;x,y : integer; couleur : Tcolor;Mode : TPenMode); -var x0,y0,orientation,adresse,i,aspect,TailleX,TailleY : integer; +var OffsetX,x0,y0,orientation,adresse,i,aspect,TailleX,TailleY,NbCellDest : integer; ImageFeu : Timage; frX,frY : real; begin x0:=(x-1)*LargeurCell; y0:=(y-1)*HauteurCell; - - Orientation:=TCO[x,y].FeuOriente; + Adresse:=TCO[x,y].Adresse; - if adresse=0 then exit; - i:=Index_feu(adresse); - if i=0 then exit; - aspect:=feux[i].aspect; + //if adresse=0 then exit; + + i:=TCO[x,y].indexfeu; + Orientation:=feuTCO[i].FeuOriente; + if Orientation=0 then Orientation:=1; // cas d'un feu non encore renseigné + + aspect:=feuTCO[i].aspect; //Affiche(IntToSTR(i)+' '+intToSTR(aspect),clred); - + + offsetX:=0; case aspect of 2 : ImageFeu:=Formprinc.Image2feux; 3 : ImageFeu:=Formprinc.Image3feux; @@ -875,60 +1473,69 @@ begin 5 : ImageFeu:=Formprinc.Image5feux; 7 : ImageFeu:=Formprinc.Image7feux; 9 : ImageFeu:=Formprinc.Image9feux; - else ImageFeu:=Formprinc.Image3feux; + else ImageFeu:=Formprinc.Image9feux; end; - //ImageFeu:=PointeurImage(adresse); // pointeur vers le type de feu à dessiner + TailleX:=ImageFeu.picture.BitMap.Width; TailleY:=ImageFeu.picture.BitMap.Height; // taille du feu d'origine (verticale) - TailleX:=ImageFeu.picture.BitMap.Width; // - //Facteurs de réductions X et Y pour un signal vertical - frX:=LargeurCell/TailleX; - frY:=2*HauteurCell/TailleY; - //Affiche('FrX='+floatToSTR(frX)+' FrY='+floatToSTR(frY),clyellow); + // réduction variable en fonction de la taille des cellules. 50 est le Zoom Maxi + calcul_reduction(frx,fry,round(TailleX*LargeurCell/ZoomMax),round(tailleY*HauteurCell/ZoomMax),TailleX,TailleY); - // affiche l'icône du signal--------------- - if (Orientation=1) then + // décalage en X pour mettre la tete du feu alignée sur le bord droit de la cellule pour les feux tournés à 90G + if orientation=2 then begin - //Affiche('Adresse='+intToSTR(Adresse)+' Xfeu='+IntToSTR(X0)+' Yfeu='+intToSTR(y0),clyellow); - TransparentBlt(canvasDest.Handle,x0,y0,LargeurCell,HauteurCell*2, + if aspect=9 then x0:=x0+round(10*frX); + if aspect=7 then x0:=x0+round(10*frX); + if aspect=5 then begin x0:=x0+round(10*frX); y0:=y0+HauteurCell-round(tailleX*frY); end; + if aspect=4 then begin x0:=x0+round(10*frX); y0:=y0+HauteurCell-round(tailleX*frY); end; + if aspect=3 then begin x0:=x0+round(10*frX); y0:=y0+HauteurCell-round(tailleX*frY); end; + if aspect=2 then begin x0:=x0+round(10*frX); y0:=y0+HauteurCell-round(tailleX*frY); end; + end; + + // orientation verticale + if (Orientation=1) then + begin + // copie avec mise à l'échelle + TransparentBlt(canvasDest.Handle,x0,y0,round(TailleX*frX),round(TailleY*frY), ImageFeu.Canvas.Handle,0,0,TailleX,TailleY,clBlue); PImageTCO.Picture.Bitmap.Modified:=True; // rafraichit l'affichage sinon le stretchblt n'apparaît pas. + if aspect=9 then affiche_pied_VerticalG(x0,y0,frX,frY); end; + + // orientation 90°G if Orientation=2 then begin - Feu_90G(ImageFeu,x,y); // ici on passe l'origine du feu - x0:=x0-largeurCell; - //Affiche('Adresse='+intToSTR(Adresse)+' Xfeu='+IntToSTR(X0)+' Yfeu='+intToSTR(y0),clyellow); - // y0:=y0+largeurCell; + Feu_90G(ImageFeu,x0,y0,frX,frY); // ici on passe l'origine du feu + // dessiner le pied + case aspect of + 9 : affiche_pied9G_90G(x0,y0,frX,frY); + 7 : affiche_pied7G_90G(x0,y0,frX,frY); + 5 : affiche_pied5G_90G(x0,y0,frX,frY); + 4 : affiche_pied4G_90G(x0,y0,frX,frY); + 3 : affiche_pied3G_90G(x0,y0,frX,frY); + 2 : affiche_pied2G_90G(x0,y0,frX,frY); + end; + end; + + // orientation 90°D if Orientation=3 then begin - Feu_90D(ImageFeu,x,y); + Feu_90D(ImageFeu,x0,y0,frX,frY); + // dessiner le pied + case aspect of + 9 : affiche_pied9G_90D(x0,y0,frX,frY); + 7 : affiche_pied7G_90D(x0,y0,frX,frY); + 5 : affiche_pied5G_90D(x0,y0,frX,frY); + 4 : affiche_pied4G_90D(x0,y0,frX,frY); + 3 : affiche_pied3G_90D(x0,y0,frX,frY); + 2 : affiche_pied2G_90D(x0,y0,frX,frY); + end; end; - // écrire le texte ------------------ - with PcanvasTCO do - begin - font.Size:=5; - Brush.Color:=fond; - Font.Color:=CouleurAdresse; - if Aspect=9 then TextOut(x0-LargeurCell,y0+8,IntToSTR(Adresse)) - else TextOut(x0+1,y0+8,IntToSTR(Adresse)); - end; - - - dessine_feu_mx(canvasDest,x0,y0,frX,frY,adresse,orientation); // allumage des feux du signal ----------------- - (* - case aspect of - 2 : dessine_feu2(canvasDest,x0,y0,frX,frY,etatsignalcplx[adresse],orientation); - 3 : dessine_feu3(canvasDest,x0,y0,frX,frY,etatsignalcplx[adresse],orientation); - 4 : dessine_feu4(canvasDest,x0,y0,frX,frY,etatsignalcplx[adresse],orientation); - 5 : dessine_feu5(canvasDest,x0,y0,frX,frY,etatsignalcplx[adresse],orientation); - 7 : dessine_feu7(canvasDest,x0,y0,frX,frY,etatsignalcplx[adresse],orientation); - 9 : dessine_feu_mx(canvasDest,x0,y0,frX,frY,etatsignalcplx[adresse],orientation); - end; *) + dessine_feu_mx(canvasDest,x0,y0,frX,frY,adresse,orientation); end; procedure TFormTCO.Efface_Cellule(Canvas : Tcanvas;x,y : integer; couleur : Tcolor;Mode : TPenMode); @@ -938,12 +1545,12 @@ begin if y>1 then begin // si la cellule au dessus contient un feu vertical, ne pas effacer la cellule - if (tco[x,y-1].BImage=12) and (tco[x,y-1].FeuOriente=1) then exit; + // if (tco[x,y-1].BImage=12) and (tco[x,y-1].FeuOriente=1) then exit; end; if x=2) and (btype<=14) then pos:=Aiguillage[adresse].position; + Xorg:=(x-1)*LargeurCell; Yorg:=(y-1)*HauteurCell; - s:=IntToSTR(i); + s:=IntToSTR(adresse); if Btype=2 then s:='A'+s; if Btype=3 then s:='A'+s+'B'; - if y>1 then if (tco[x,y-1].Bimage=12) and (tco[x,y-1].FeuOriente=1) then exit; + i:=Tco[x,y].IndexFeu; + + if y>1 then if (tco[x,y-1].Bimage=30) and (FeuTCO[i].FeuOriente=1) then exit; case Bimage of - // ne pas passer la forme ds le paramètre canvas, çà ne s'affichera pas // 0 : efface_cellule(PCanvasTCO,x,y,Clyellow,Mode); &&&&&&&&& - 1 : dessin_AigPD_AD(PCanvasTCO,X,Y,Clyellow,Mode); - 2 : dessin_AigG_PD(PCanvasTCO,X,Y,Clyellow,mode); - 3 : dessin_AigPG_AG(PCanvasTCO,X,Y,Clyellow,mode); - 4 : dessin_AigD_PG(PCanvasTCO,X,Y,Clyellow,Mode); - 5 : dessin_voie(PCanvasTCO,X,Y,Clyellow,Mode); + 1 : dessin_voie(PCanvasTCO,X,Y,Clyellow,Mode); + 2 : dessin_AigG_PD(PCanvasTCO,X,Y,Clyellow,mode,pos); + 3 : dessin_AigPG_AG(PCanvasTCO,X,Y,Clyellow,mode,pos); + 4 : dessin_AigD_PG(PCanvasTCO,X,Y,Clyellow,Mode,pos); + 5 : dessin_AigPD_AD(PCanvasTCO,X,Y,Clyellow,Mode,pos); 6 : dessin_SupG(PCanvasTCO,X,Y,Clyellow,Mode); 7 : dessin_SupD(PCanvasTCO,X,Y,Clyellow,Mode); 8 : dessin_infD(PCanvasTCO,X,Y,Clyellow,Mode); 9 : dessin_infG(PCanvasTCO,X,Y,Clyellow,mode); 10 : dessin_Diag1(PCanvasTCO,X,Y,Clyellow,mode); 11 : dessin_Diag2(PCanvasTCO,X,Y,Clyellow,mode); - 12 : dessin_feu(PCanvasTCO,X,Y,Clyellow,mode); - - //else entoure_cell(x,y); + 12 : dessin_Aig45PG_AG(PCanvasTCO,X,Y,Clyellow,mode,pos); + 13 : dessin_Aig45PD_AD(PCanvasTCO,X,Y,Clyellow,mode,pos); + 14 : dessin_Aig45PD_AG(PCanvasTCO,X,Y,Clyellow,mode,pos); + 15 : dessin_Aig45PG_AD(PCanvasTCO,X,Y,Clyellow,mode,pos); + 30 : dessin_feu(PCanvasTCO,X,Y,Clyellow,mode); end; + PCanvasTCO.font.Size:=(LargeurCell div 10)+4 ; +// Affiche(intToSTR( (LargeurCell div 30)+6),clyellow); - if (BImage>=2) and (BImage<12) and (i<>0) then - begin // Adresse de l'élément - with PCanvasTCO do - begin - font.Size:=5; - Brush.Color:=fond; - Font.Color:=CouleurAdresse; - TextOut(xOrg+1,yOrg+1,s); - end; - end - else - if (BImage=1) and (i<>0) then - begin // Adresse de l'élément - with PCanvasTCO do - begin - font.Size:=5; - Brush.Color:=fond; - Font.Color:=CouleurAdresse; - TextOut(xOrg+1,yOrg+21,s); - end; - end; - //canvasTCO.TextOut(xOrg+1,yOrg+1,IntToSTR(x)); + // affiche le texte des aiguillages + if (BImage>=2) and (BImage<29) and (adresse<>0) then + begin // Adresse de l'élément + with PCanvasTCO do + begin + Brush.Color:=fond; + Font.Color:=clYellow; + x:=0;y:=0; + if Bimage=4 then begin x:=1;y:=0;end; + if Bimage=5 then begin x:=1;y:=HauteurCell-12;end; + if Bimage=12 then begin x:=1;y:=HauteurCell-12;end; + TextOut(xOrg+x,yOrg+y,s); + exit; + end; + end; + + // détecteurs + if (BImage=1) and (adresse<>0) then + begin // Adresse de l'élément + with PCanvasTCO do + begin + Brush.Color:=fond; + Font.Color:=clWhite; + TextOut(xOrg+1,yOrg+1,s); + exit; + end; + end; + + // texte des signaux + if (BImage=30) and (adresse<>0) then + begin + i:=tco[x,y].IndexFeu; + if i=0 then exit; + aspect:=feuTCO[i].aspect; + oriente:=Feutco[i].FeuOriente; + x:=0;y:=0; + if (aspect=9) and (Oriente=1) then begin x:=LargeurCell-round(18*frXGlob);y:=2*HauteurCell-round(18*fryGlob);end; + if (aspect=9) and (Oriente=2) then begin x:=round(10*frXGlob);y:=HauteurCell-round(17*frYGlob);end; // orientation G + if (aspect=9) and (Oriente=3) then begin x:=LargeurCell+2;y:=1;end; + if (aspect=7) and (Oriente=1) then begin x:=LargeurCell-round(18*frXGlob);y:=HauteurCell+1;end; + if (aspect=7) and (Oriente=2) then begin x:=round(10*frXGlob);y:=HauteurCell-round(15*frYGlob);end; + if (aspect=7) and (Oriente=3) then begin x:=LargeurCell+2;y:=1;end; + if (aspect=5) and (Oriente=1) then begin x:=round(24*frXGlob);y:=1;end; + if (aspect=5) and (Oriente=2) then begin x:=round(10*frXGlob);y:=round(2*frYGlob);end; + if (aspect=5) and (Oriente=3) then begin x:=round(10*frXGlob);y:=HauteurCell-round(22*frYGlob);end; + if (aspect=4) and (Oriente=1) then begin x:=LargeurCell-18;y:=1;end; + if (aspect=4) and (Oriente=2) then begin x:=round(10*frXGlob);y:=round(2*frYGlob);end; + if (aspect=4) and (Oriente=3) then begin x:=round(10*frXGlob);y:=HauteurCell-round(22*frYGlob);end; + if (aspect=3) and (Oriente=1) then begin x:=LargeurCell-18;y:=1;end; + if (aspect=3) and (Oriente=2) then begin x:=round(10*frXGlob);y:=round(2*frYGlob);end; + if (aspect=3) and (Oriente=3) then begin x:=round(10*frXGlob);y:=HauteurCell-round(22*frYGlob);end; + if (aspect=2) and (Oriente=1) then begin x:=LargeurCell-round(18*frXGlob);y:=1;end; // orientation V + if (aspect=2) and (Oriente=2) then begin x:=round(10*frXGlob);y:=round(2*frYGlob);end; // orientation G + if (aspect=2) and (Oriente=3) then begin x:=round(10*frXGlob);y:=HauteurCell-round(22*frYGlob);end; // orientation D + with PCanvasTCO do + begin + Brush.Color:=fond; + Font.Color:=clLime; + TextOut(xOrg+x,yOrg+y,s); + end; + end; + + //canvasTCO.TextOut(xOrg+1,yOrg+1,IntToSTR(x)); end; // affiche le tco suivant le tableau TCO procedure TformTCO.Affiche_TCO ; -var x,y,DimX,DimY : integer; +var x,y,x0,y0,DimX,DimY : integer; s : string; r : Trect; begin @@ -1072,11 +1728,16 @@ begin PScrollBoxTCO.HorzScrollBar.Range:=DimX; PScrollBoxTCO.VertScrollBar.Range:=DimY; + + calcul_reduction(frxGlob,fryGlob,LargeurCell,HauteurCell,ZoomMax,ZoomMax); + + //Affiche(formatfloat('0.000000',frxGlob),clyellow); //effacer tout with PcanvasTCO do begin Brush.Color:=clWhite; + Pen.width:=1; r:=rect(0,0,ImageTCO.Width,ImageTCO.height); FillRect(r); Brush.Style:=bsSolid; @@ -1086,41 +1747,62 @@ begin FillRect(r); end; - //afficher les cellules + //afficher les cellules sauf les feux for y:=1 to NbreCellY do for x:=1 to NbreCellX do begin - affiche_cellule(x,y,PmCopy); + if TCO[x,y].BImage<>30 then affiche_cellule(x,y,PmCopy); + end; + + PCanvasTCO.Font.Size:=8; + //afficher les cellules des feux pour que les pieds recouvrent le reste et afficher les textes + for y:=1 to NbreCellY do + for x:=1 to NbreCellX do + begin + if TCO[x,y].BImage=30 then affiche_cellule(x,y,PmCopy); + s:=Tco[x,y].Texte; + if s<>'' then + begin + x0:=(x-1)*Largeurcell; + y0:=(y-1)*hauteurcell; + PcanvasTCO.Textout(x0+2,y0+1,s); + end; end; // afficher la grille grille; + + if entoure then + begin + Entoure_cell(Xentoure,Yentoure); + end; + end; procedure TFormTCO.FormCreate(Sender: TObject); begin caption:='TCO'; - LargeurCell:=25; - HauteurCell:=25; AvecGrille:=true; + TCO_modifie:=false; XclicCell:=1; YclicCell:=1; + xCoupe:=0;yCoupe:=0; KeyPreview:=false; // invalide les évènements clavier fond:=$202050; couleurAdresse:=Cyan; - xMiniSel:=999;yMiniSel:=999; + xMiniSel:=99999;yMiniSel:=99999; xMaxiSel:=0;yMaxiSel:=0; SelectionAffichee:=false; + ImageTCO.Canvas.font.Name:='Arial'; end; - - // clic gauche sur image procedure TFormTCO.ImageTCOClick(Sender: TObject); var Position: TPoint; + i ,adresse,Bimage : integer; + s : string; begin - //Entoure_cell(XclicCell,YclicCell); GetCursorPos(Position); Position:=ImageTCO.screenToCLient(Position); @@ -1130,7 +1812,33 @@ begin YclicCell:=Yclic div hauteurCell +1; if XclicCell>NbreCellX then exit; if YclicCell>NbreCellY then exit; - + + Bimage:=tco[XClicCell,YClicCell].Bimage; + + if not(SelectionAffichee) then // si la sélection bleue n'est pas affichée + begin + if not(entoure) then // si la cellule n'avait pas été entourée + begin + Entoure_cell(XclicCell,YclicCell); + entoure:=true; + Xentoure:=XClicCell;Yentoure:=YclicCell; + end + else + begin + Entoure_cell(Xentoure,Yentoure); // efface l'ancien + Entoure_cell(XclicCell,YclicCell); + Xentoure:=XClicCell;Yentoure:=YclicCell; + end; + + if (Bimage=1) or (Bimage=0) then + begin + s:=Tco[XClicCell,YClicCell].Texte; + EditTexte.Text:=s; + EditTexte.Visible:=true + end + else EditTexte.Visible:=false; + + end; LabelX.caption:=IntToSTR(XclicCell); LabelY.caption:=IntToSTR(YclicCell); @@ -1140,8 +1848,15 @@ begin EditAdrElement.Text:=IntToSTR(tco[XClicCellInserer,YClicCellInserer].Adresse); EdittypeElement.Text:=IntToSTR(tco[XClicCellInserer,YClicCellInserer].BType); - EdittypeImage.Text:=IntToSTR(tco[XClicCellInserer,YClicCellInserer].BImage); + EdittypeImage.Text:=IntToSTR(BImage); + if Bimage=30 then //feu + begin + Adresse:=tco[XClicCellInserer,YClicCellInserer].Adresse; + i:=Index_Feu(adresse); + end; + + //Affiche('XClicCell='+intToSTR(XclicCell)+' '+'YClicCell='+intToSTR(YclicCell),clyellow); //Affiche('Evt ImageTCOclick',clYellow); end; @@ -1161,6 +1876,7 @@ begin Pen.Mode:=PmXor; r:=Rect(x0,y0,x0+largeurCell,y0+LargeurCell); Rectangle(r); + Pen.width:=1; // FillRect(r); end; @@ -1172,7 +1888,31 @@ begin if not(Forminit) then begin FormInit:=true; + Button1.Visible:=not(Diffusion); + Button2.Visible:=not(Diffusion); + ImageTemp.Visible:=not(Diffusion); + lire_fichier_tco; + + calcul_reduction(frxGlob,fryGlob,LargeurCell,HauteurCell,ZoomMax,ZoomMax); + // dessiner les icônes + dessin_AigPD_AD(ImagePalette5.Canvas,1,1,clyellow,pmCopy,0); + dessin_AigG_PD(ImagePalette2.Canvas,1,1,clyellow,pmCopy,0); + dessin_AigPG_AG(ImagePalette3.Canvas,1,1,clyellow,pmCopy,0); + dessin_AigD_PG(ImagePalette4.Canvas,1,1,clyellow,pmCopy,0); + dessin_voie(ImagePaletteDroit.canvas,1,1,Clyellow,pmCopy); + dessin_SupG(ImageSupG.canvas,1,1,Clyellow,pmCopy); + dessin_SupD(ImageSupD.canvas,1,1,Clyellow,pmCopy); + dessin_InfD(ImageInfD.canvas,1,1,Clyellow,pmCopy); + dessin_infG(ImageInfG.canvas,1,1,Clyellow,pmCopy); + dessin_Diag1(ImageDiag1.Canvas,1,1,Clyellow,pmCopy); + dessin_Diag2(ImageDiag2.Canvas,1,1,Clyellow,pmCopy); + dessin_Aig45PG_AG(ImageAig45PG_AG.Canvas,1,1,Clyellow,pmCopy,0); + dessin_Aig45PD_AD(ImageAig45PD_AD.Canvas,1,1,Clyellow,pmCopy,0); + dessin_Aig45PD_AG(ImageAig45PD_AG.Canvas,1,1,Clyellow,pmCopy,0); + dessin_Aig45PG_AD(ImageAig45PG_AD.Canvas,1,1,Clyellow,pmCopy,0); + + ImageTCO.Width:=LargeurCell*NbreCellX; ImageTCO.Height:=HauteurCell*NbreCellY; @@ -1188,19 +1928,6 @@ begin PImageTemp:=FormTCO.ImageTemp; PImageTemp.Canvas.Rectangle(0,0,PImageTemp.Width,PimageTemp.Height); - // dessiner les icônes - dessin_AigPD_AD(ImagePalette1.Canvas,1,1,clyellow,pmCopy); - dessin_AigG_PD(ImagePalette2.Canvas,1,1,clyellow,pmCopy); - dessin_AigPG_AG(ImagePalette3.Canvas,1,1,clyellow,pmCopy); - dessin_AigD_PG(ImagePalette4.Canvas,1,1,clyellow,pmCopy); - dessin_voie(ImagePaletteDroit.canvas,1,1,Clyellow,pmCopy); - dessin_SupG(ImageSupG.canvas,1,1,Clyellow,pmCopy); - dessin_SupD(ImageSupD.canvas,1,1,Clyellow,pmCopy); - dessin_InfD(ImageInfD.canvas,1,1,Clyellow,pmCopy); - dessin_infG(ImageInfG.canvas,1,1,Clyellow,pmCopy); - dessin_Diag1(ImageDiag1.Canvas,1,1,Clyellow,pmCopy); - dessin_Diag2(ImageDiag2.Canvas,1,1,Clyellow,pmCopy); - With ImageFeu do begin Picture.Bitmap.TransparentMode:=tmAuto; @@ -1210,7 +1937,8 @@ begin end; Affiche_tco; end; - + TrackBarZoom.Position:=ZoomMax-LargeurCell+20; + end; // evt qui se produit quand on clic droit dans l'image @@ -1225,9 +1953,28 @@ begin Xclic:=position.X;YClic:=position.Y; XclicCell:=Xclic div largeurCell +1; YclicCell:=Yclic div hauteurCell +1; + + if not(SelectionAffichee) then + begin + if not(entoure) then + begin + Entoure_cell(XclicCell,YclicCell);entoure:=true; + Xentoure:=XClicCell;Yentoure:=YclicCell; + end + else + begin + Entoure_cell(Xentoure,Yentoure); // efface l'ancien + Entoure_cell(XclicCell,YclicCell); + Xentoure:=XClicCell;Yentoure:=YclicCell; + end; + end; + LabelX.caption:=IntToSTR(XclicCell); LabelY.caption:=IntToSTR(YclicCell); + label1.caption:='clicContext'; + + XclicCellInserer:=XClicCell; YclicCellInserer:=YClicCell; //Entoure_cell(XclicCellInserer,YclicCellInserer); @@ -1235,39 +1982,9 @@ begin //Affiche('XClicCell='+intToSTR(XclicCell)+' '+'YClicCell='+intToSTR(YclicCell),clyellow); end; -// menu droit "clic aiguillage G PG" -procedure TFormTCO.aiguillageG_PGClick(Sender: TObject); -var Position: TPoint; -begin - // effacer le carré pointeur - //Entoure_cell(XclicCell,YclicCell); - // dessine le dessin - dessin_AigPG_AG(ImageTCO.canvas,XClicCellInserer,YClicCellInserer,clyellow,pmCopy); - // remet le carré pointeur - //Entoure_cell(XclicCell,YclicCell); - - EditAdrElement.Text:=IntToSTR(tco[XClicCellInserer,YClicCellInserer].Adresse); - EdittypeElement.Text:=IntToSTR(tco[XClicCellInserer,YClicCellInserer].BType); - -end; - -// menu droit "clic aiguillage D PD" -procedure TFormTCO.aiguillageD_PDClick(Sender: TObject); -var Position: TPoint; -begin - // effacer le carré pointeur - //Entoure_cell(XclicCell,YclicCell); - // dessine le dessin - dessin_AigPD_AD(ImageTCO.Canvas,XClicCellInserer,YClicCellInserer,clyellow,pmCopy); - // remet le carré pointeur - //Entoure_cell(XclicCell,YclicCell); - - EditAdrElement.Text:=IntToSTR(tco[XClicCellInserer,YClicCellInserer].Adresse); - EdittypeElement.Text:=IntToSTR(tco[XClicCellInserer,YClicCellInserer].BType); - -end; +(* procedure TFormTCO.Aiguillagegauchepointedroite1Click(Sender: TObject); var Position: TPoint; begin @@ -1281,24 +1998,24 @@ begin EditAdrElement.Text:=IntToSTR(tco[XClicCellInserer,YClicCellInserer].Adresse); EdittypeElement.Text:=IntToSTR(tco[XClicCellInserer,YClicCellInserer].BType); -end; +end; procedure TFormTCO.Aiguillagedroitpointegauche1Click(Sender: TObject); var Position: TPoint; begin tco[XClicCellInserer,YClicCellInserer].Adresse:=1; - tco[XClicCellInserer,YClicCellInserer].Btype:=1; + tco[XClicCellInserer,YClicCellInserer].Btype:=5; // effacer le carré pointeur //Entoure_cell(XclicCell,YclicCell); // dessine le dessin - dessin_AigD_PG(ImageTCO.canvas,XClicCellInserer,YClicCellInserer,clyellow,pmCopy); + dessin_AigD_PG(ImageTCO.canvas,XClicCellInserer,YClicCellInserer,clyellow,pmCopy,0); // remet le carré pointeur //Entoure_cell(XclicCell,YclicCell); EditAdrElement.Text:=IntToSTR(tco[XClicCellInserer,YClicCellInserer].Adresse); EdittypeElement.Text:=IntToSTR(tco[XClicCellInserer,YClicCellInserer].BType); -end; +end; *) procedure TFormTCO.FormKeyDown(Sender: TObject; var Key: Word;Shift: TShiftState); begin @@ -1397,38 +2114,37 @@ begin accept:=true; end; -procedure TFormTCO.ImagePalette1MouseDown(Sender: TObject; +procedure TFormTCO.ImagePalette5MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin - ImagePalette1.BeginDrag(true); + ImagePalette5.BeginDrag(true); end; -procedure TFormTCO.ImagePalette1EndDrag(Sender, Target: TObject; X, +procedure TFormTCO.ImagePalette5EndDrag(Sender, Target: TObject; X, Y: Integer); begin if (x=0) and (y=0) then exit; + TCO_modifie:=true; Xclic:=X;YClic:=Y; XclicCell:=Xclic div largeurCell +1; YclicCell:=Yclic div hauteurCell +1; - dessin_AigPD_AD(ImageTCO.Canvas,XClicCell,YClicCell,Clyellow,pmCopy); + dessin_AigPD_AD(ImageTCO.Canvas,XClicCell,YClicCell,Clyellow,pmCopy,0); tco[XClicCell,YClicCell].BType:=2; // aiguillage - tco[XClicCell,YClicCell].BImage:=1; // image 1 - + tco[XClicCell,YClicCell].BImage:=5; // image 5 + EditAdrElement.Text:=IntToSTR( tco[XClicCell,YClicCell].Adresse); EdittypeElement.Text:=IntToSTR( tco[XClicCell,YClicCell].Btype); EdittypeImage.Text:=IntToSTR(tco[XClicCell,YClicCell].BImage); end; - - -procedure TFormTCO.ImagePalette2EndDrag(Sender, Target: TObject; X, - Y: Integer); +procedure TFormTCO.ImagePalette2EndDrag(Sender,Target: TObject; X,Y: Integer); begin if (x=0) and (y=0) then exit; + TCO_modifie:=true; Xclic:=X;YClic:=Y; XclicCell:=Xclic div largeurCell +1; YclicCell:=Yclic div hauteurCell +1; - dessin_AigG_PD(ImageTCO.Canvas,XClicCell,YClicCell,Clyellow,pmCopy); + dessin_AigG_PD(ImageTCO.Canvas,XClicCell,YClicCell,Clyellow,pmCopy,0); tco[XClicCell,YClicCell].BType:=2; // aiguillage tco[XClicCell,YClicCell].BImage:=2; // image 2 @@ -1446,10 +2162,11 @@ end; procedure TFormTCO.ImagePalette3EndDrag(Sender, Target: TObject; X,Y: Integer); begin if (x=0) and (y=0) then exit; + TCO_modifie:=true; Xclic:=X;YClic:=Y; XclicCell:=Xclic div largeurCell +1; YclicCell:=Yclic div hauteurCell +1; - dessin_AigPG_AG(ImageTCO.Canvas,XClicCell,YClicCell,Clyellow,pmCopy); + dessin_AigPG_AG(ImageTCO.Canvas,XClicCell,YClicCell,Clyellow,pmCopy,0); tco[XClicCell,YClicCell].BType:=2; // aiguillage tco[XClicCell,YClicCell].BImage:=3; // image 3 @@ -1467,10 +2184,11 @@ end; procedure TFormTCO.ImagePalette4EndDrag(Sender, Target: TObject; X,Y: Integer); begin if (x=0) and (y=0) then exit; + TCO_modifie:=true; Xclic:=X;YClic:=Y; XclicCell:=Xclic div largeurCell +1; YclicCell:=Yclic div hauteurCell +1; - dessin_AigD_PG(ImageTCO.Canvas,XClicCell,YClicCell,Clyellow,pmCopy); + dessin_AigD_PG(ImageTCO.Canvas,XClicCell,YClicCell,Clyellow,pmCopy,0); tco[XClicCell,YClicCell].BType:=2; // aiguillage tco[XClicCell,YClicCell].BImage:=4; // image 4 @@ -1489,12 +2207,13 @@ procedure TFormTCO.ImagePaletteDroitEndDrag(Sender, Target: TObject; X, Y: Integer); begin if (x=0) and (y=0) then exit; + TCO_modifie:=true; Xclic:=X;YClic:=Y; XclicCell:=Xclic div largeurCell +1; YclicCell:=Yclic div hauteurCell +1; dessin_voie(ImageTCO.Canvas,XClicCell,YClicCell,Clyellow,pmCopy); tco[XClicCell,YClicCell].BType:=1; // voie - tco[XClicCell,YClicCell].BImage:=5; // image 5 + tco[XClicCell,YClicCell].BImage:=1; // image 1 tco[XClicCell,YClicCell].Adresse:=0; EditAdrElement.Text:=IntToSTR( tco[XClicCell,YClicCell].Adresse); @@ -1511,6 +2230,7 @@ end; procedure TFormTCO.ImageSupGEndDrag(Sender, Target: TObject; X,Y: Integer); begin if (x=0) and (y=0) then exit; + TCO_modifie:=true; Xclic:=X;YClic:=Y; XclicCell:=Xclic div largeurCell +1; YclicCell:=Yclic div hauteurCell +1; @@ -1533,6 +2253,7 @@ procedure TFormTCO.ImageSupDEndDrag(Sender, Target: TObject; X, Y: Integer); begin if (x=0) and (y=0) then exit; + TCO_modifie:=true; Xclic:=X;YClic:=Y; XclicCell:=Xclic div largeurCell +1; YclicCell:=Yclic div hauteurCell +1; @@ -1556,6 +2277,7 @@ procedure TFormTCO.ImageInfDEndDrag(Sender, Target: TObject; X, Y: Integer); begin if (x=0) and (y=0) then exit; + TCO_modifie:=true; Xclic:=X;YClic:=Y; XclicCell:=Xclic div largeurCell +1; YclicCell:=Yclic div hauteurCell +1; @@ -1581,10 +2303,38 @@ begin ImageInfG.BeginDrag(true); end; + +procedure TFormTCO.ImageAig45PG_AGMouseDown(Sender: TObject; + Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +begin + ImageAig45PG_AG.BeginDrag(true); +end; + + +procedure TFormTCO.ImageAig45PD_ADMouseDown(Sender: TObject; + Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +begin + ImageAig45PD_AD.BeginDrag(true); +end; + + +procedure TFormTCO.ImageAig45PD_AGMouseDown(Sender: TObject; + Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +begin + ImageAig45PD_AG.BeginDrag(true); +end; + +procedure TFormTCO.ImageAig45PG_ADMouseDown(Sender: TObject; + Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +begin + ImageAig45PG_AD.BeginDrag(true); +end; + procedure TFormTCO.ImageInfGEndDrag(Sender, Target: TObject; X, Y: Integer); begin if (x=0) and (y=0) then exit; + TCO_modifie:=true; Xclic:=X;YClic:=Y; XclicCell:=Xclic div largeurCell +1; YclicCell:=Yclic div hauteurCell +1; @@ -1598,12 +2348,103 @@ begin EdittypeImage.Text:=IntToSTR(tco[XClicCell,YClicCell].BImage); end; +procedure TFormTCO.ImageAig45PG_AGEndDrag(Sender, Target: TObject; X, + Y: Integer); +begin + if (x=0) and (y=0) then exit; + TCO_modifie:=true; + Xclic:=X;YClic:=Y; + XclicCell:=Xclic div largeurCell +1; + YclicCell:=Yclic div hauteurCell +1; + dessin_Aig45PG_AG(ImageTCO.Canvas,XClicCell,YClicCell,Clyellow,pmCopy,0); + tco[XClicCell,YClicCell].BType:=0; // rien + tco[XClicCell,YClicCell].BImage:=12; // image 12 + tco[XClicCell,YClicCell].Adresse:=0; // rien + + EditAdrElement.Text:=IntToSTR( tco[XClicCell,YClicCell].Adresse); + EdittypeElement.Text:=IntToSTR( tco[XClicCell,YClicCell].Btype); + EdittypeImage.Text:=IntToSTR(tco[XClicCell,YClicCell].BImage); +end; + + +procedure TFormTCO.ImageAig45PD_ADEndDrag(Sender, Target: TObject; X, + Y: Integer); +begin + if (x=0) and (y=0) then exit; + TCO_modifie:=true; + Xclic:=X;YClic:=Y; + XclicCell:=Xclic div largeurCell +1; + YclicCell:=Yclic div hauteurCell +1; + dessin_Aig45PD_AD(ImageTCO.Canvas,XClicCell,YClicCell,Clyellow,pmCopy,0); + tco[XClicCell,YClicCell].BType:=0; // rien + tco[XClicCell,YClicCell].BImage:=13; // image 13 + tco[XClicCell,YClicCell].Adresse:=0; // rien + + EditAdrElement.Text:=IntToSTR( tco[XClicCell,YClicCell].Adresse); + EdittypeElement.Text:=IntToSTR( tco[XClicCell,YClicCell].Btype); + EdittypeImage.Text:=IntToSTR(tco[XClicCell,YClicCell].BImage); +end; + +procedure TFormTCO.ImageAig45PD_AGEndDrag(Sender, Target: TObject; X, + Y: Integer); +begin + if (x=0) and (y=0) then exit; + TCO_modifie:=true; + Xclic:=X;YClic:=Y; + XclicCell:=Xclic div largeurCell +1; + YclicCell:=Yclic div hauteurCell +1; + dessin_Aig45PD_AG(ImageTCO.Canvas,XClicCell,YClicCell,Clyellow,pmCopy,0); + tco[XClicCell,YClicCell].BType:=0; // rien + tco[XClicCell,YClicCell].BImage:=14; // image 14 + tco[XClicCell,YClicCell].Adresse:=0; // rien + + EditAdrElement.Text:=IntToSTR( tco[XClicCell,YClicCell].Adresse); + EdittypeElement.Text:=IntToSTR( tco[XClicCell,YClicCell].Btype); + EdittypeImage.Text:=IntToSTR(tco[XClicCell,YClicCell].BImage); +end; + + +procedure TFormTCO.ImageAig45PG_ADEndDrag(Sender, Target: TObject; X, + Y: Integer); +begin + if (x=0) and (y=0) then exit; + TCO_modifie:=true; + Xclic:=X;YClic:=Y; + XclicCell:=Xclic div largeurCell +1; + YclicCell:=Yclic div hauteurCell +1; + Dessin_Aig45PG_AD(ImageTCO.Canvas,XClicCell,YClicCell,Clyellow,pmCopy,0); + tco[XClicCell,YClicCell].BType:=0; // rien + tco[XClicCell,YClicCell].BImage:=15; // image 15 + tco[XClicCell,YClicCell].Adresse:=0; // rien + + EditAdrElement.Text:=IntToSTR( tco[XClicCell,YClicCell].Adresse); + EdittypeElement.Text:=IntToSTR( tco[XClicCell,YClicCell].Btype); + EdittypeImage.Text:=IntToSTR(tco[XClicCell,YClicCell].BImage); +end; + procedure TFormTCO.ButtonSauveTCOClick(Sender: TObject); begin sauve_fichier_tco; end; -procedure copier; +procedure TFormTCO.MenuCollerClick(Sender: TObject); +var x,y,xPlace,yPlace : integer; +begin + if TamponAffecte then + begin + for y:=TamponTCO_Org.y1 to TamponTCO_Org.y2 do // rectangle de la sélection + for x:=TamponTCO_Org.x1 to TamponTCO_Org.x2 do + begin + xPlace:=XclicCell+x-TamponTCO_Org.x1; // destination + yPlace:=YclicCell+y-TamponTCO_Org.y1; + if (xPlace<=NbreCellX) and (yPlace<=NbreCellY) then tco[xPlace,yPlace]:=tamponTCO[x,y]; + end; + end; + Affiche_TCO; + TCO_modifie:=true; +end; + +procedure copier; var x,y : integer; begin if SelectionAffichee then @@ -1612,9 +2453,6 @@ begin TamponTCO_Org.x2:=XmaxiSel div LargeurCell +1; TamponTCO_Org.y1:=yminiSel div LargeurCell +1; TamponTCO_Org.y2:=ymaxiSel div LargeurCell +1; - - - for y:=TamponTCO_Org.y1 to TamponTCO_Org.y2 do for x:=TamponTCO_Org.x1 to TamponTCO_Org.x2 do tamponTCO[x,y]:=tco[x,y]; @@ -1623,6 +2461,11 @@ begin end; +procedure TFormTCO.MenuCopierClick(Sender: TObject); +begin + copier; +end; + // supprimer la sélection procedure TFormTCO.MenuCouperClick(Sender: TObject); var Position: TPoint; @@ -1631,15 +2474,16 @@ var Position: TPoint; begin if not(SelectionAffichee) then exit; + TCO_modifie:=true; copier; - SelectionAffichee:=false; xCell1:=XminiSel div LargeurCell +1; xCell2:=XmaxiSel div LargeurCell +1; yCell1:=yminiSel div HauteurCell +1; yCell2:=ymaxiSel div HauteurCell +1; - + + xCoupe:=XCell1;yCoupe:=yCell1; for y:=yCell1 to yCell2 do for x:=xCell1 to xCell2 do begin @@ -1647,18 +2491,40 @@ begin tco[x,y].Adresse:=0; tco[x,y].BImage:=0; //Affiche('Efface cellules '+IntToSTR(X)+' '+intToSTR(y),clyellow); - efface_cellule(ImageTCO.Canvas,X,Y,Clyellow,PmCopy); - + efface_cellule(ImageTCO.Canvas,X,Y,fond,PmCopy); + if avecGrille then grille; end; - end; +procedure TFormTCO.AnnulercouperClick(Sender: TObject); +var x,y,Xplace,yplace : integer; +begin + if TamponAffecte then + begin + if (xCoupe<>0) and (ycoupe<>0) then + begin + for y:=TamponTCO_Org.y1 to TamponTCO_Org.y2 do // rectangle de la sélection + for x:=TamponTCO_Org.x1 to TamponTCO_Org.x2 do + begin + xPlace:=xCoupe+x-TamponTCO_Org.x1; // destination + yPlace:=yCoupe+y-TamponTCO_Org.y1; + if (xPlace<=NbreCellX) and (yPlace<=NbreCellY) then tco[xPlace,yPlace]:=tamponTCO[x,y]; + end; + end; + end; + Affiche_TCO; +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; + begin +// ImageTCO.BeginDrag(true); if button=mbLeft then begin - xMiniSel:=999;yMiniSel:=999; + xMiniSel:=99999;yMiniSel:=99999; xMaxiSel:=0;yMaxiSel:=0; sourisclic:=true; if SelectionAffichee then @@ -1674,6 +2540,7 @@ begin SelectionAffichee:=false; end; end; + if button=mbRight then begin GetCursorPos(Position); @@ -1693,9 +2560,7 @@ begin EditAdrElement.Text:=IntToSTR(tco[XClicCellInserer,YClicCellInserer].Adresse); EdittypeElement.Text:=IntToSTR(tco[XClicCellInserer,YClicCellInserer].BType); - EdittypeImage.Text:=IntToSTR(tco[XClicCellInserer,YClicCellInserer].BImage); - - end; + end; end; procedure TFormTCO.ImageTCOMouseMove(Sender: TObject; Shift: TShiftState;X, Y: Integer); @@ -1709,6 +2574,8 @@ begin SourisY.Caption:=IntToSTR(y); if not(sourisclic) then exit; + + // on a cliqué la souris en la bougeant : sélection bleue en cours //Affiche('MouseMove',clyellow); GetCursorPos(Position); Position:=ImageTCO.screenToCLient(Position); @@ -1768,6 +2635,8 @@ begin Rectangle(r); end; SelectionAffichee:=true; + if entoure then Entoure_cell(Xentoure,Yentoure); // efface + entoure:=false; end; procedure TFormTCO.ImageTCOMouseUp(Sender: TObject; Button: TMouseButton; @@ -1780,27 +2649,7 @@ end; -procedure TFormTCO.MenuCopierClick(Sender: TObject); -begin - copier; -end; -procedure TFormTCO.MenuCollerClick(Sender: TObject); -var x,y,xPlace,yPlace : integer; -begin - if TamponAffecte then - begin - for y:=TamponTCO_Org.y1 to TamponTCO_Org.y2 do // rectangle de la sélection - for x:=TamponTCO_Org.x1 to TamponTCO_Org.x2 do - begin - xPlace:=XclicCell+x-TamponTCO_Org.x1; // destination - yPlace:=YclicCell+y-TamponTCO_Org.y1; - if (xPlace<=NbreCellX) and (yPlace<=NbreCellY) then tco[xPlace,yPlace]:=tamponTCO[x,y]; - end; - end; - Affiche_TCO; - -end; procedure TFormTCO.ButtonRedessineClick(Sender: TObject); begin @@ -1809,7 +2658,7 @@ end; // changement de l'adresse d'un élément procedure TFormTCO.EditAdrElementChange(Sender: TObject); -var Adr,erreur,i : integer; +var Adr,erreur,i,index : integer; begin Val(EditAdrElement.Text,Adr,erreur); if (erreur<>0) or (Adr<0) or (Adr>2048) then @@ -1819,18 +2668,29 @@ begin end; tco[XClicCell,YClicCell].Adresse:=Adr; - affiche_cellule(XClicCell,YClicCell,pmCopy); + TCO_modifie:=true; + // Efface_cellule(PCanvasTCO,XClicCell,YClicCell+1,Fond,pmcopy); + // si c'est un feu, mettre à jour le tableau FeuTCO - if tco[XClicCell,YClicCell].BImage=12 then + if tco[XClicCell,YClicCell].BImage=30 then begin - - i:=0; - while i0) or (Bimage<0) or (Bimage>11) then + if (erreur<>0) or (Bimage<0) or (Bimage>15) then begin EditTypeImage.text:=intToSTR(tco[XClicCell,YClicCell].BImage); exit; end; + TCO_modifie:=true; tco[XClicCell,YClicCell].Bimage:=Bimage; case Bimage of // aiguillages - 1,2,3,4 : tco[XClicCell,YClicCell].Btype:=2; + 1,2,3,4,13,14,15 : tco[XClicCell,YClicCell].Btype:=2; // détecteur ou voie 5 : tco[XClicCell,YClicCell].Btype:=1; else tco[XClicCell,YClicCell].Btype:=0; @@ -1861,7 +2722,7 @@ begin end; end; -procedure TFormTCO.Maj_TCO(Adresse : integer;etat : boolean); +procedure TFormTCO.Maj_TCO(Adresse : integer); var x,y : integer; begin for y:=1 to NbreCellY do @@ -1874,19 +2735,25 @@ end; procedure TFormTCO.Button1Click(Sender: TObject); begin - Affiche(IntToSTR(NbfeuTCO),clyellow); + Detecteur[569]:=true; + Maj_tco(569); end; + procedure TFormTCO.Button2Click(Sender: TObject); begin - Detecteur[513]:=false; - Maj_tco(513,false); + Detecteur[569]:=false; + Maj_tco(569); end; + // dépose d'un feu sur le TCO procedure TFormTCO.ImageDiag1EndDrag(Sender, Target: TObject; X, Y: Integer); +var i : integer; begin if (x=0) and (y=0) then exit; + TCO_modifie:=true; + inc(NbFeuTCO); Xclic:=X;YClic:=Y; XclicCell:=Xclic div largeurCell +1; YclicCell:=Yclic div hauteurCell +1; @@ -1894,14 +2761,13 @@ begin tco[XClicCell,YClicCell].BType:=0; // rien tco[XClicCell,YClicCell].BImage:=10; // image 10 tco[XClicCell,YClicCell].Adresse:=0; - tco[XClicCell,YClicCell].FeuOriente:=1; - - inc(NbFeuTCO); - FeuTCO[NbFeuTCO].Adresse:=0; - FeuTCO[NbFeuTCO].FeuOriente:=1; - FeuTCO[NbFeuTCO].x:=XClicCell; - FeuTCO[NbFeuTCO].y:=YClicCell; - + tco[XClicCell,YClicCell].IndexFeu:=NbFeuTCO; + Feutco[NbFeuTCO].FeuOriente:=1; + + FeuTCO[NbFeuTCO].Adresse:=0; + FeuTCO[NbFeuTCO].x:=XClicCell; + FeuTCO[NbFeuTCO].y:=YClicCell; + EditAdrElement.Text:=IntToSTR( tco[XClicCell,YClicCell].Adresse); EdittypeElement.Text:=IntToSTR( tco[XClicCell,YClicCell].Btype); EdittypeImage.Text:=IntToSTR(tco[XClicCell,YClicCell].BImage); @@ -1917,6 +2783,7 @@ procedure TFormTCO.ImageDiag2EndDrag(Sender, Target: TObject; X, Y: Integer); begin if (x=0) and (y=0) then exit; + TCO_modifie:=true; Xclic:=X;YClic:=Y; XclicCell:=Xclic div largeurCell +1; YclicCell:=Yclic div hauteurCell +1; @@ -1945,29 +2812,29 @@ end; procedure TFormTCO.ImageFeuEndDrag(Sender, Target: TObject; X, Y: Integer); var r : Trect; + i : integer; begin if (x=0) and (y=0) then exit; + TCO_modifie:=true; Xclic:=X;YClic:=Y; XclicCell:=Xclic div largeurCell +1; YclicCell:=Yclic div hauteurCell +1; //PCanvasTCO.Draw((xClicCell-1)*LargeurCell,(yClicCell-1)*HauteurCell,ImageFeu.Picture.Bitmap); tco[XClicCell,YClicCell].BType:=0; // rien - tco[XClicCell,YClicCell].BImage:=12; + tco[XClicCell,YClicCell].BImage:=30; tco[XClicCell,YClicCell].Adresse:=0; - tco[XClicCell,YClicCell].FeuOriente:=1; - - Affiche(IntToSTR(XclicCell),clyellow); - Affiche(IntToSTR(YclicCell),clyellow); - - TransparentBlt(PcanvasTCO.Handle,(xClicCell-1)*LargeurCell,(yClicCell-1)*HauteurCell,LargeurCell,HauteurCell*2,Formprinc.Image9feux.Canvas.Handle,0,0, - Formprinc.Image9feux.Picture.Bitmap.Width,Formprinc.Image9feux.Picture.Bitmap.Height,clBlue); - PImageTCO.Picture.Bitmap.Modified:=True; // rafraichit l'affichage sinon le stretchblt n'apparaît pas. + inc(NbFeuTCO); + tco[XClicCell,YClicCell].indexFeu:=NbFeuTCO; + FeuTco[NbFeuTCO].FeuOriente:=1; + FeuTco[NbFeuTCO].Aspect:=9; EditAdrElement.Text:=IntToSTR( tco[XClicCell,YClicCell].Adresse); EdittypeElement.Text:=IntToSTR( tco[XClicCell,YClicCell].Btype); EdittypeImage.Text:=IntToSTR(tco[XClicCell,YClicCell].BImage); -end; + dessin_feu(PCanvasTCO,XclicCell,YClicCell,Clyellow,pmCopy); + +end; procedure TFormTCO.ImageFeuMouseDown(Sender: TObject; Button: TMouseButton; @@ -1978,39 +2845,153 @@ end; procedure TFormTCO.Tourner90GClick(Sender: TObject); -var BImage,aspect,adresse : integer; +var BImage,aspect,adresse,index : integer; ImageFeu : TImage; + frX,frY : real; begin BImage:=TCO[XClicCell,YClicCell].Bimage; - if Bimage<>12 then exit; + if Bimage<>30 then exit; + + TCO_modifie:=true; adresse:=TCO[XClicCell,YClicCell].Adresse; - ImageFeu:=PointeurImage(adresse); + index:=TCO[XClicCell,YClicCell].indexFeu; + + // effacement de l'ancien feu + if FeuTCO[index].FeuOriente=3 then + begin + Efface_Cellule(PCanvasTCO,xClicCell,yClicCell,fond,PmCopy); + Efface_Cellule(PCanvasTCO,xClicCell+1,yClicCell,fond,PmCopy); + end; + + if FeuTCO[index].FeuOriente=2 then + begin + Efface_Cellule(PCanvasTCO,xClicCell,yClicCell,fond,PmCopy); + Efface_Cellule(PCanvasTCO,xClicCell-1,yClicCell,fond,PmCopy); + end; - TCO[XClicCell,YClicCell].FeuOriente:=2; // feu orienté à 90° gauche - // effacer le feu - Efface_Cellule(PCanvasTCO,xClicCell,yClicCell,clred,PmCopy); + // si l'image était verticale, il faut effacer la cellule en bas + if FeuTCO[index].FeuOriente=1 then + begin + Efface_Cellule(PCanvasTCO,xClicCell,yClicCell,fond,PmCopy); + Efface_Cellule(PCanvasTCO,xClicCell,yClicCell+1,fond,PmCopy); + end; - Feu_90G(ImageFeu,XClicCell,YclicCell); - Efface_cellule(PCanvasTCO,xClicCell,yClicCell+1,clred,PmCopy); // efface la partie basse du feu vertical + FeuTCO[index].FeuOriente:=2; // feu orienté à 90° gauche + + dessin_feu(PCanvasTCO,XclicCell,YClicCell,Clyellow,pmCopy); end; procedure TFormTCO.Tourner90DClick(Sender: TObject); -var BImage ,aspect,adresse : integer; +var BImage ,aspect,adresse,index : integer; ImageFeu : TImage; + frX,frY : real; begin BImage:=TCO[XClicCell,YClicCell].Bimage; - if Bimage<>12 then exit; - adresse:=TCO[XClicCell,YClicCell].Adresse; - ImageFeu:=PointeurImage(adresse); - - TCO[XClicCell,YClicCell].FeuOriente:=3; // feu orienté à 90° droit - // effacer le feu - Efface_Cellule(PCanvasTCO,xClicCell,yClicCell,clred,PmCopy); - - Feu_90D(ImageFeu,XClicCell,YclicCell); - Efface_cellule(PcanvasTCO,xClicCell,yClicCell+1,clred,PmCopy); // efface la partie basse du feu vertical + if Bimage<>30 then exit; + TCO_modifie:=true; + adresse:=TCO[XClicCell,YClicCell].Adresse; + index:=TCO[XClicCell,YClicCell].indexFeu; + aspect:=FeuTCO[index].aspect; + if aspect=0 then aspect:=9; + + // ancien feu orienté orienté 90D + if FeuTCO[index].FeuOriente=3 then + begin + Efface_Cellule(PCanvasTCO,xClicCell,yClicCell,fond,PmCopy); + if aspect>=4 then Efface_Cellule(PCanvasTCO,xClicCell+1,yClicCell,fond,PmCopy); + end; + + // ancien feu orienté orienté 90G + if FeuTCO[index].FeuOriente=2 then + begin + Efface_Cellule(PCanvasTCO,xClicCell,yClicCell,fond,PmCopy); + if aspect>=4 then Efface_Cellule(PCanvasTCO,xClicCell+1,yClicCell,fond,PmCopy); + end; + + // si l'image était verticale, il faut effacer la cellule en bas + if FeuTCO[index].FeuOriente=1 then + begin + Efface_Cellule(PCanvasTCO,xClicCell,yClicCell,fond,PmCopy); + Efface_Cellule(PCanvasTCO,xClicCell,yClicCell+1,fond,PmCopy); + end; + + FeuTCO[index].FeuOriente:=3; // feu orienté à 90° droit + dessin_feu(PCanvasTCO,XclicCell,YClicCell,Clyellow,pmCopy); end; +procedure TFormTCO.Pos_vertClick(Sender: TObject); +var BImage ,aspect,index,Adresse : integer; + ImageFeu : TImage; +begin + BImage:=TCO[XClicCell,YClicCell].Bimage; + // si c'est autre chose qu'un feu, sortir + if Bimage<>30 then exit; + + TCO_modifie:=true; + adresse:=TCO[XClicCell,YClicCell].Adresse; + index:=TCO[XClicCell,YClicCell].indexFeu; + aspect:=feuTCO[index].aspect; + if aspect=0 then aspect:=9; + + // effacement de l'ancien feu + + // ancien feu orienté orienté 90D + if FeuTCO[index].FeuOriente=3 then + begin + Efface_Cellule(PCanvasTCO,xClicCell,yClicCell,fond,PmCopy); + // si le feu occupe 2 cellules + if aspect>=4 then Efface_Cellule(PCanvasTCO,xClicCell+1,yClicCell,fond,PmCopy); + end; + + // ancien feu orienté orienté 90G + if FeuTCO[index].FeuOriente=2 then + begin + Efface_Cellule(PCanvasTCO,xClicCell,yClicCell,fond,PmCopy); + // si le feu occupe 2 cellules + if aspect>=4 then Efface_Cellule(PCanvasTCO,xClicCell+1,yClicCell,fond,PmCopy); + end; + + // si l'image était verticale, il faut effacer la cellule en bas + if FeuTCO[index].FeuOriente=1 then + begin + Efface_Cellule(PCanvasTCO,xClicCell,yClicCell,fond,PmCopy); + Efface_Cellule(PCanvasTCO,xClicCell,yClicCell+1,fond,PmCopy); + end; + + FeuTCO[index].FeuOriente:=1; // feu orienté à 180° + dessin_feu(PCanvasTCO,XclicCell,YClicCell,Clyellow,pmCopy); + +end; + +procedure TFormTCO.TrackBarZoomChange(Sender: TObject); +begin + LargeurCell:=ZoomMax-TrackBarZoom.Position+20; + hauteurCell:=LargeurCell; + Affiche_TCO; + SelectionAffichee:=false; +end; + + +// interdire la fermeture de la fenêtre tco +procedure TFormTCO.FormClose(Sender: TObject; var Action: TCloseAction); +begin + action:=tCloseAction(caNone); +end; + +procedure TFormTCO.EditTexteChange(Sender: TObject); +var x0,y0 : integer; +begin + x0:=(XClicCell-1)*LargeurCell; + y0:=(YClicCell-1)*HauteurCell; + + PCanvasTCO.TextOut(x0+2,y0+2,EditTexte.Text); + Tco[XClicCell,YClicCell].Texte:=EditTexte.Text; + TCO_modifie:=true; +end; + +begin + + end. diff --git a/config.cfg b/config.cfg index 9149741..ecbaa5e 100644 --- a/config.cfg +++ b/config.cfg @@ -1,129 +1,128 @@ /****************************************** -/ fichier de configuration de signaux_complexes -/ gily - f1iwq - 2018 -/****************************************** +/ fichier de configuration de signaux complexes +/ cap de bouheyre avec signaux - 2018 +/**************************************** / Sans Log=0 / Avec Log=1 : génère un fichier log Log=0 / Affichage du débug du calcul des routes, et enregistrement dans le log si la variable précédente est à 1 TraceDet=0 -/ Envoie un 0 après le pilotage des décodeurs -/ Mettre 1 si utilisation de décodeurs LEB -RazSignaux=1 +/ si 1 envoie un 0 après le pilotage des décodeurs LEB +RazSignaux=0 / / modélisation des aiguillages : détermine les éléments connectés aux 3 branches des aiguilles (Pointe, Droit, Dévié (S) -/ adresse d'aiguillage,P=élément vers pointe D=élément vers Droit, S=élément vers dévié. -/ [60 ou 30 dans le cas d'un aiguillage en position déviée qui doit être fanchie à 30 ou 60] -/ Elément = détecteur (valeur uniquement numérique) ou aiguillage (adresse+branche de connexion (P S ou D) -/ Exemple : 1,P518,D523,S3P signifie : définition de l'aiguillage @1 : sur pointe relié au détecteur 518 +/ adresse d'aiguillage[B],P=élément vers pointe D=élément vers Droit, S=élément vers dévié +/ B pour adresse d'aiguillage déja utilisée +/ Elément = détecteur (valeur uniquement numérique) ou aiguillage (adresse [TRI,TJS,TJD]+branche de connexion (P S ou D) +/ Exemples : 1,P518,D523,S3P signifie : définition de l'aiguillage @1 : sur pointe relié au détecteur 518 / sur Droit relié au détecteur 518 / sur Dévié, relié à l'aiguillage 3 en pointe -/ Pour une TJD : 26TJD,D530,S529,P28 -/ P désigne l'autre adresse de la TJD -/ Aiguillage triple -/ +/ Voir la documentation des signaux complexes pour une description complete / S'il n'y a pas de détecteur connecté à une branche d'aiguillage, mettre 0. -1,P518,S3P,D523,30 -2,P12S,S5S,D519 -3,P1S,S5D,D4P -4,P3D,S514,D6S -5,P515,S2S,D3S -6,P516,S4D,D0 -7,P527,S520,D519 -8,P527,S522,D521 -9,P526,S515,D513,60 -10,P19P,S528,D29P,30 -11,P18P,D30D,S525 -12,P517,D20S,S2P -17,P525,D535,S528 -18,P11P,S517,D23P -19,P10P,S531,D22P -20,P520,D21P,S12D -21,P20D,S28D,D28D -22,P19D,S538,D537 -23,P18D,S534,D538 -24,P538,S533,D32S -25,P31S,D529,S27P -26TJD,D530,S529,P28 -28TJD,D21D,S21S,P26 -27,P25S,D530,S537 -29,P10D,S30S,D513,60 -30,P524,S29D,D11D -31,P534,S25P,D0 -32,P22S,S24D,D0 +1,S1BS,P2P,D3P,0 +1B,P553,D16P,S1S +2,P1P,D4P,S2BS +2B,P521,D16D,S2S +3,P1D,D522,S5BP +4,P2D,D554,S6BP +5,P9P,S15P,D5BS +5B,P3S,S5D,D545,0,1 +6,P10P,S546,D6BS +6B,P4S,D545,S6D +7,P15S,D566,S565 +8,P20P,D566,S565 +9,P5P,D530,S17P +10,P6P,D530,S18P +13,P17S,D563,S564 +14,P18S,D563,S564 +15,P5S,D546,S7P +16,P1BD,S16BS,D2BD +16B,P0,S16S,D557 +17,P9S,D531,S13P +18,P10S,D562,S14P +20,P8P,D547,S548 +21,P25P,S537,D23S +22,P24P,S561,D25S +23,P569,S21D,D538 +24,P22P,S26P,D513 +25,P21P,S22D,D570 +26,P24S,S515,D514 +28,P30P,S29P,D570 +29,P28S,D516,S31P +30,P28P,D32S,S539 +31TRI,27,P29S,D518,S0,S2-517 +32,P571,D538,S30D 0 // / modélisation du réseau par branche -/ 1 ligne par branche - le sens de parcours de la branche est arbitraire. -/ Chaque ligne (branche) doit commmencer et finir par un aiguillage -/ Une ligne qui finit par un 0 signifie un heurtoir +/ 1 ligne par branche - le sens de parcours de la description n'a pas d'importance. +/ Chaque ligne (branche) doit comporter au moins un détecteur et au moins aiguillage / @ détecteur A=@aiguillage -/ Terminer par 0 -/ Exemple : 519 est un détecteur - A2 est l'aiguillage 2 +/ chaque ligne doit commencer par un aiguillage et se terminer par un aiguillage +/ Terminer par les brances par 0 +/ Exemple : 519 est un détecteur - A2 est l'aiguillage 2 - A1B est l'aiguillage 1bis / -A2,A12,517,A18,A11,A30,524,521,A8,527,A7,519,A2 -A7,520,A20,A12 -A1,A3,A4,514,522,A8 -A1,523,526,A9,513,A29,A10,A19,531,518,A1 -A9,515,A5 -A11,525,A17,528,A10 -A17,535,533,A24,538,A23 -A7,520,A20,A21,A28,A26,530,A27,A25,A31,534,A23,A18 -A26,529,A25 -A22,537,A27 -A22,A32,A24 -A6,516,0 -A31,0 +/ rouge - jaune +A20,547,561,A22,A24,A26,515,518,A31,A29,A28,A30,539,522,A3,A1,A2,A4,A6B,545,A5B,A3 +A26,514,517,A31 +A26,515,518,A31 +A24,513,516,A29 +/grande boucle extérieure départ de couche rouge: de 569 à 569 +A23,538,A32,571,553,A1B,A16,A2B,521,569,A23 +/ grande boucle intérieure +A21,A25,570,A28 +A4,554,537,A21 +/ couche jaune +A10,530,A9,A5,A15,546,A6 +A18,562,531,A17 +A14,563,A13 +A14,564,A13 +/ +A7,565,A8 +A7,566,A8 +A16B,557,0 +A20S,548,0 0 -/ liste des adresses des signaux et leur forme, pour affichage de l'image correspondante , -/ avec ou sans bouton de commande pour le feu blanc, type de décodeur [, type de cible (pour les décodeurs Unisemaf uniquement)] +/ +/ liste des signaux / la liste doit être terminée par une adresse à 0 -/ forme : 2=2 feux(carré violet/blanc) / 3=3 feux / 4=4 feux / 5=5 feux (carré + blanc ou violet) -/ 7=7 feux (blanc ou violet + ralentissement / 9=9 feux (blanc ou violet + rappel ralentissement) -/ Dx : signal directionnel à x feux -/ type de décodeur : 1=digital Bahn 2=CDF 3=LDT 4=LEB 5=NMRA 6=Unisemaf +/ forme : 2=2 feux(carré violet/blanc) / 3=3 feux / 4=4 feux (carré) / 5=5 feux (carré + blanc) +/ 7=7 feux (carré+blanc + ralentissement / 9=9 feux (blanc ou violet + rappel ralentissement) +/ type de décodeur : 0=feu virtuel 1=digital Bahn 2=CDF 3=LDT 4=LEB +/ l'énumération des détecteurs ne nécessite pas de parenthèses si il est seul, mais il faut des parenthèses si +/ le signal concerne plusieurs voies (donc détecteurs) / Notation de chaque ligne: -/ adresse de base du signal, forme, avec ou sans bouton de commande du feu blanc, type de décodeur [, détecteur (det2, det3, ...) , élément suivant , -/ avec ou sans demande de verrouillage du feu au carré] -/ -176,7,0,1,(520,A20),1 -190,7,0,1,(523,526),1 -204,9,0,1,(527,A7),1 -218,7,0,1,(525,A17),1 -232,2,1,1,(516,A6),1 -260,9,1,1,(518,A1),1 -274,3,0,1,(524,521),1 -288,7,0,1,(522,A8),1 -302,9,0,1,(526,A9),1 -316,7,1,1,(515,A5),1 -330,7,0,1,(519,A2),1 -344,9,0,1,(528,A10),1 -358,9,0,1,(517,A18),1 -372,D3,1,(A10D)(A19S)(A19D,A22D)(A19D,A22S) -382,D3,1,(A29S,A10S)(A19S)(A19D,A22D)(A19D,A22S) -392,3,0,1,(535,533),1 -420,7,0,1,(529,A25,530,A27,537,A27),1 -448,7,0,1,(533,A24),1 -462,9,0,1,(513,A29),1 -476,9,0,1,(538,A23),1 -497,9,0,4,(531,A19),1 -600,7,0,0,(521,A8),1 +/ adresse de base du signal, forme, réserve, type de décodeur [, (détecteur,..detecteur , élément suivant ..) , +/ avec ou sans demande de verrouillage du feu au carré (0 ou 1)] +161,4,0,4,(538,A32),0 +169,9,0,4,(539,A30),0, +177,9,0,4,(569,A23),0 +185,4,0,4,(570,A25),0 +193,4,0,4,(516,A29),0 +201,2,0,4,(517,31TRI,518,31TRI),0 +209,9,0,4,(513,A24),0 +217,2,0,4,(514,A26,515,A26),0 +225,9,0,4,(561,A22),0 +233,4,0,4,(547,A20),0 +241,4,0,4,(548,A20),1 +1001,3,0,0,(537,554),0 +1003,3,0,0,(553,A1B),0 +1005,3,0,0,(571,553),0 +1007,3,0,0,(554,A4),0 +1009,3,0,0,(522,539),0 +1011,3,0,0,(521,569),0 +1013,3,0,0,(565,A7),0 +1015,3,0,0,(562,A18),0 +1017,3,0,0,(563,A14),0 +1019,3,0,0,(564,A14),0 0 / -/ Section actionneurs. Ne fonctionne qu'en mode connecté à CDM en run / Fonctions Fx à envoyer aux locomotives sur passage d'un actionneur -/ actionneur,état,Nom du train,fonction,temporisation en ms avant remise à 0 -/ -/ Passages à niveau (PN) -/ (act_ferme_voie1,act_ouvre_voie1),(act_ferme_voie2,act_ouvre_voie2),...,PN(adresse_ferme,adresse_ouvre) -/ -/ Klaxon (F2) -/ 815,1,CC406526,F2,400 -/ -/ passage à niveau à 2 voies +/ Uniquement en mode connecté à CDM +/ actionneur,état,Nom de la loco,fonction,temporisation en ms avant remise à 0 +/815,1,CC406526,F2,400 /(815,830),(820,840),PN(121+,121-) -/ -/ passage à niveau à 1 voie /(815,809),PN(121+,121-) 0 + diff --git a/configgily.cfg b/configgily.cfg index a2ee5a3..77b490a 100644 --- a/configgily.cfg +++ b/configgily.cfg @@ -107,9 +107,26 @@ A31,0 476,9,0,1,(538,A23),1 497,9,0,4,(531,A19),1 600,7,0,0,(521,A8),1 -610,9,0,6,(520,A20),0,7 +/ signaux de test +610,4,0,0,(521,a8),1 +615,5,0,0,(521,a8),1 0 / - +/ Section actionneurs. Ne fonctionne qu'en mode connecté à CDM en run +/ Fonctions Fx à envoyer aux locomotives sur passage d'un actionneur +/ actionneur,état,Nom du train,fonction,temporisation en ms avant remise à 0 +/ +/ Passages à niveau (PN) +/ (act_ferme_voie1,act_ouvre_voie1),(act_ferme_voie2,act_ouvre_voie2),...,PN(adresse_ferme,adresse_ouvre) +/ +/ Klaxon (F2) +/ 815,1,CC406526,F2,400 +/ +/ passage à niveau à 2 voies +/(815,830),(820,840),PN(121+,121-) +/ +/ passage à niveau à 1 voie +/(815,809),PN(121+,121-) +0 diff --git a/verif_version.dcu b/verif_version.dcu index 219fd7a..e6d70cd 100644 Binary files a/verif_version.dcu and b/verif_version.dcu differ diff --git a/verif_version.pas b/verif_version.pas index 14be910..cfb3728 100644 --- a/verif_version.pas +++ b/verif_version.pas @@ -21,8 +21,9 @@ type var FormVersion: TFormVersion; Lance_verif : integer; + verifVersion,notificationVersion : boolean; -Const Version='1.5'; //Version='1.2';// sert à la comparaison de la version publiée +Const Version='1.6'; //Version='1.2';// sert à la comparaison de la version publiée implementation @@ -65,8 +66,8 @@ var dwTimeout : integer; begin Result:=False; - - Try Fs:=TFileStream.Create(s,fmCreate); + DeleteFile(s); + Try Fs:=TFileStream.Create(s,fmCreate,fmShareDenyNone); hSession:=InternetOpen('MyApp',INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0); try if Assigned(hSession) then @@ -105,7 +106,8 @@ var s,s2,s3,Version_p,Url,LocalFile : string; V_publie,V_utile : real; begin //Affiche('vérifie version',clLime); - if not(AvecInit) then exit ; + if not(AvecInit) then exit ; + if not(verifVersion) then exit; Url:='http://cdmrail.free.fr/ForumCDR/viewtopic.php?f=77&t=3906#p50499'; LocalFile:='page.txt'; trouve_version:=false; @@ -166,6 +168,7 @@ begin Aff(s); if MessageDlg(s+'. Voulez-vous la télécharger?',mtConfirmation,[mbYes,mbNo],0)=mrYes then begin + // récupérer depuis la variable d'environnement windows USERPROFILE le repertoire de la session ouverte s:=GetCurrentProcessEnvVar('USERPROFILE')+'\Downloads\Signaux_Complexes_GL.Zip'; Aff('Téléchargement de '+s3+' dans '); Aff(s); @@ -181,13 +184,13 @@ begin else formVersion.Free; end; - // if V_utile=V_publie then Affiche('Votre version '+Version_p+' est à jour',clLime); + if (V_utile=V_publie) and notificationVersion then Affiche('Votre version '+Version_p+' est à jour',clLime); end; end else begin - //Affiche('Pas d''accès au site CDM rail',clorange); + if notificationVersion then Affiche('Pas d''accès au site CDM rail',clorange); end; end; diff --git a/versions.txt b/versions.txt index 626e61d..e1987cc 100644 --- a/versions.txt +++ b/versions.txt @@ -17,4 +17,7 @@ Version 1.42 : Correction erreur lecture signaux Version 1.43 : Correction erreur gestion sémaphore Version 1.44 : Gestion trains avec voitures éclairées Version 1.45 : Rejette les n° d'objets supérieurs aiguillages à la même adresse -Version 1.5 : Nouvel algorithme de suivi des trains +Version 1.5 : Nouvel algorithme de suivi des trains - Gestion des feux provenant de voies en buttoir +Version 1.6 : Implémentation du TCO. Ouverture de CDM rail au démarrage avec LAY à la demande + +