unit frmVuePlan2D; // 22/07/2024: Point de contrôle temporel (contrôle de version) {$INCLUDE CompilationParameters.inc} {$IFDEF GHTOPO_SIMPLIFIE} {$ERROR Le mode GHTOPO_SIMPLIFIE est valable exclusivement pour le projet GHTopoRPI} {$ENDIF} interface uses {$INCLUDE SelectionLangues.inc} StructuresDonnees, GHTopoGeneralFunctions, unitDatesUtils, unitGHTopoViseesUtils, unitGHTopoStringUtils, unitColorsUtils, unitSolveEquationsPolynomes, Classes, SysUtils, Math, // anciennement Include ToporobotClasses2012, UnitEntitesExtended, unitclassemaillage, unitCroquisTerrain, UnitUtilsVisualTopo, CadreGHTopoContext2D, FastGEO, CallDialogsStdVersion, unitUtilsComposants, CadreListesPourVueGraphique, UnitTPathBetweenNodes, UnitGraphes1, BZGraphesClasses, UnitObjetSerie, CadreBoussole, LazFileUtils, LCLIntf, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls, ComCtrls, Buttons, ActnList, PairSplitter, StdCtrls, ExtDlgs; type { TfrmVueEnPlan } TfrmVueEnPlan = class(TForm) acF2DZoomAll: TAction; acF2DZoomPlus: TAction; acF2DZoomMoins: TAction; acF2DPanVue: TAction; acF2DZoomFenetre: TAction; acF2DParamOnglet: TAction; acF2DStatistiques: TAction; acF2DDistance: TAction; acF2DVue3D: TAction; acF2DPrintPlan: TAction; acF2DLocaliserStation: TAction; acShowFenetreSeries: TAction; acShowFenetreListeSimples: TAction; acShowFenetreConsole: TAction; acCreerTimelapse: TAction; acSaveAs: TAction; acFermerUnCheminement: TAction; acLoadMaillage: TAction; acF2DExportDXF: TAction; acF2DExportSVG: TAction; acF2DCalculerLeReseau: TAction; acF2DExtractProfilTerrain: TAction; acNewPolyligne: TAction; acNewAnnotation: TAction; acDeletePolyline: TAction; acDeleteAnnotation: TAction; acSaveCroquis: TAction; acOpenCroquis: TAction; acExportPlanEnPNG: TAction; ActionList1: TActionList; btnExchange: TButton; btnPathNext: TButton; btnPickPathStationArr: TButton; btnPickPathStationDep: TButton; btnStationArrivee: TButton; btnStationDepart: TButton; btnStyleObjet1: TStaticText; btnStyleObjet10: TStaticText; btnStyleObjet2: TStaticText; btnStyleObjet3: TStaticText; btnStyleObjet4: TStaticText; btnStyleObjet5: TStaticText; btnStyleObjet6: TStaticText; btnStyleObjet7: TStaticText; btnStyleObjet9: TStaticText; btnPathPrevious: TButton; btnSelectItineraire: TButton; btnExportHTML: TButton; CdrBoussole1: TCdrBoussole; CdrListesPourVisualisateurs1: TCdrListesPourVisualisateurs; chkAltitudes: TCheckBox; chkTopoNavig: TCheckBox; chkPOI: TCheckBox; chkAntennes: TCheckBox; chkCotes: TCheckBox; chkEntranceNames: TCheckBox; chkEntrances: TCheckBox; chkIDStations: TCheckBox; chkNoeuds: TCheckBox; chkParois: TCheckBox; chkPolygonales: TCheckBox; chkRemplissage: TCheckBox; chkSections: TCheckBox; chkStations: TCheckBox; GHTopoContext2DA1: TGHTopoContext2DA; ImageList1: TImageList; Label1: TLabel; Label2: TLabel; Label3: TLabel; Label4: TLabel; Label5: TLabel; lbEtapeProgression: TLabel; lbNbPathStations: TLabel; lbNextWpt: TStaticText; lbNextWptAzimut: TStaticText; lbNextWptDistance: TStaticText; lsbPathRoadMap: TComboBox; PairSplitter1: TPairSplitter; PairSplitter2: TPairSplitter; PairSplitterSide1: TPairSplitterSide; PairSplitterSide2: TPairSplitterSide; PairSplitterSide3: TPairSplitterSide; PairSplitterSide4: TPairSplitterSide; Panel1: TPanel; OngletsVues: TTabControl; Panel2: TPanel; Panel3: TPanel; Panel4: TPanel; Panel5: TPanel; Panel6: TPanel; Panel7: TPanel; pnlGrapheReseau: TPanel; pnlProgression: TPanel; pnlStylesPolylines: TPanel; pnlOutilsDessin: TPanel; ProgressBar1: TProgressBar; SpeedButton1: TSpeedButton; SpeedButton10: TSpeedButton; SpeedButton11: TSpeedButton; SpeedButton12: TSpeedButton; SpeedButton13: TSpeedButton; SpeedButton16: TSpeedButton; SpeedButton17: TSpeedButton; SpeedButton18: TSpeedButton; SpeedButton2: TSpeedButton; SpeedButton20: TSpeedButton; SpeedButton21: TSpeedButton; SpeedButton22: TSpeedButton; SpeedButton23: TSpeedButton; SpeedButton24: TSpeedButton; SpeedButton25: TSpeedButton; SpeedButton26: TSpeedButton; SpeedButton27: TSpeedButton; SpeedButton28: TSpeedButton; SpeedButton29: TSpeedButton; SpeedButton31: TSpeedButton; SpeedButton32: TSpeedButton; SpeedButton33: TSpeedButton; SpeedButton34: TSpeedButton; SpeedButton35: TSpeedButton; SpeedButton36: TSpeedButton; SpeedButton38: TSpeedButton; SpeedButton39: TSpeedButton; SpeedButton4: TSpeedButton; lbStatutCroquisTerrain: TStaticText; btnStyleObjet0: TStaticText; SpeedButton40: TSpeedButton; SpeedButton41: TSpeedButton; btnStyleObjet8: TStaticText; SpeedButton42: TSpeedButton; SpeedButton43: TSpeedButton; procedure acCreerTimelapseExecute(Sender: TObject); procedure acDeleteAnnotationExecute(Sender: TObject); procedure acDeletePolylineExecute(Sender: TObject); procedure acExportPlanEnPNGExecute(Sender: TObject); procedure acF2DCalculerLeReseauExecute(Sender: TObject); procedure acF2DDistanceExecute(Sender: TObject); procedure acF2DExportSVGExecute(Sender: TObject); procedure acF2DExtractProfilTerrainExecute(Sender: TObject); procedure acF2DLocaliserStationExecute(Sender: TObject); procedure acF2DPanVueExecute(Sender: TObject); procedure acF2DParamOngletExecute(Sender: TObject); procedure acF2DPrintPlanExecute(Sender: TObject); procedure acF2DZoomAllExecute(Sender: TObject); procedure acF2DZoomFenetreExecute(Sender: TObject); procedure acF2DZoomMoinsExecute(Sender: TObject); procedure acF2DZoomPlusExecute(Sender: TObject); procedure acF2DStatistiquesExecute(Sender: TObject); procedure acF2DVue3DExecute(Sender: TObject); procedure acFermerUnCheminementExecute(Sender: TObject); procedure acLoadMaillageExecute(Sender: TObject); procedure acNewAnnotationExecute(Sender: TObject); procedure acNewPolyligneExecute(Sender: TObject); procedure acOpenCroquisExecute(Sender: TObject); procedure acSaveAsExecute(Sender: TObject); procedure acSaveCroquisExecute(Sender: TObject); procedure acShowFenetreConsoleExecute(Sender: TObject); procedure acShowFenetreListeSimplesExecute(Sender: TObject); procedure acShowFenetreSeriesExecute(Sender: TObject); procedure btnExchangeClick(Sender: TObject); procedure btnExportHTMLClick(Sender: TObject); procedure btnPathNextClick(Sender: TObject); procedure btnPathPreviousClick(Sender: TObject); procedure btnPickPathStationArrClick(Sender: TObject); procedure btnPickPathStationDepClick(Sender: TObject); procedure btnStationArriveeClick(Sender: TObject); procedure btnStationDepartClick(Sender: TObject); procedure btnStyleObjet0Click(Sender: TObject); procedure btnStyleObjet10Click(Sender: TObject); procedure btnStyleObjet1Click(Sender: TObject); procedure btnStyleObjet2Click(Sender: TObject); procedure btnStyleObjet3Click(Sender: TObject); procedure btnStyleObjet4Click(Sender: TObject); procedure btnStyleObjet5Click(Sender: TObject); procedure btnStyleObjet6Click(Sender: TObject); procedure btnStyleObjet7Click(Sender: TObject); procedure btnStyleObjet8Click(Sender: TObject); procedure btnStyleObjet9Click(Sender: TObject); procedure btnSelectItineraireClick(Sender: TObject); procedure chkAltitudesChange(Sender: TObject); procedure chkAntennesChange(Sender: TObject); procedure chkCotesChange(Sender: TObject); procedure chkEntranceNamesChange(Sender: TObject); procedure chkEntrancesChange(Sender: TObject); procedure chkIDStationsChange(Sender: TObject); procedure chkNoeudsChange(Sender: TObject); procedure chkParoisChange(Sender: TObject); procedure chkPOIChange(Sender: TObject); procedure chkPolygonalesChange(Sender: TObject); procedure chkRemplissageChange(Sender: TObject); procedure chkSectionsChange(Sender: TObject); procedure chkStationsChange(Sender: TObject); procedure chkTopoNavigChange(Sender: TObject); procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); procedure FormCloseQuery(Sender: TObject; var CanClose: boolean); procedure FormCreate(Sender: TObject); procedure FormResize(Sender: TObject); procedure FormShow(Sender: TObject); procedure FormWindowStateChange(Sender: TObject); procedure lsbPathRoadMapChange(Sender: TObject); procedure OngletsVuesChange(Sender: TObject); private { private declarations } FBDDEntites : TBDDEntites; FDocTopo : TToporobotStructure2012; FListeOfMaillages : TListeOfMaillages; FGraphe : TPathFindingGraphe; FDoIncludeVerticales : boolean; FShortestPath : TPathBetweenNodes; FCurrentNomFichierXTB: TStringDirectoryFilename; FProcRecalculerReseau: TProcOfObjectWithOneBoolParameter; FProcProgression : TProcDisplayProgression; procedure DisplayBearingToNext(const IdxWpt: integer); procedure QExportVisualTopo(const QFilename: TStringDirectoryFilename); function RecalculerShortestPath(const StationDepart, StationArrivee: string): boolean; procedure ChangeAttrElementsAffiches(const QIdx: TElementDrawn; const QChecked: boolean); procedure DispAttrElementsAffiches(const EA: TSetElementsDrawn); procedure PerformActionWithBaseStation(const BP: TBaseStation; const TodoAction: TTodoAction); procedure PerformActionWithTwoBaseStation(const ST1, ST2: TBaseStation); procedure InitCaptions(); procedure PreparerVues(); procedure ProcDisplayProgression(const Etape: string; const Done, Starting, Ending, Step: integer); procedure SetModeFonctionnement(const MF: TModeFonctionnementGHTopoContext2D); procedure SetPanelStyles(const QCurrStyleIdx: integer); public { public declarations } function InitialiserVue2D(const D: TToporobotStructure2012; const C: TCroquisTerrain; const P: TBDDEntites; const AM: TListeOfMaillages; const G: TPathFindingGraphe; const CheminMinimal: TPathBetweenNodes; const QFileName: TStringDirectoryFilename; const QProcRecalcul: TProcOfObjectWithOneBoolParameter; const DoIncludeVerticales: boolean): boolean; procedure setProcProgression(const P: TProcDisplayProgression); procedure Finaliser(); function GetParamsOngletCourant(): TVue2DParams; procedure PutParamsOngletCourant(const O: TVue2DParams); function GetMaillage(const Idx: integer): TMaillage; procedure CentrerBasepointSurPlan(const BP: TToporobotIDStation); procedure CentrerXYSurPlan(const QX, QY: double; const TagString: string); procedure CentrerNearStSurPlan(const NearST: TStationProcheOfEndSerie); procedure CentrerBipointSurPlan(const BP: TBipointBaseStation); procedure DemanderChargementDeMNT(); procedure ActiverPanelMaillage(); procedure DemanderExportPlanToSVG(); function getListeSeriesSelectionnees(): string; function getMetaFiltre(): string; procedure setDoIncludeVerticales(const B: boolean); end; var frmVueEnPlan: TfrmVueEnPlan; implementation {$R *.lfm} { TfrmVueEnPlan } uses frmFrontalSeries , frmLesListesSimples , frmJournal ; procedure TfrmVueEnPlan.ProcDisplayProgression(const Etape: string; const Done, Starting, Ending, Step: integer); begin if (0 = Done MOD Step) then begin lbEtapeProgression.Caption := format('%s: Station %d of %d', [Etape, Done, Ending]); ProgressBar1.Min := Starting; ProgressBar1.Max := Ending; ProgressBar1.Position := Done; Application.ProcessMessages; end; end; procedure TfrmVueEnPlan.acF2DDistanceExecute(Sender: TObject); begin if (GHTopoContext2DA1.CanDraw) then GHTopoContext2DA1.SetModeTravail(mtDISTANCE_PREMIER_POINT); end; procedure TfrmVueEnPlan.acF2DExportSVGExecute(Sender: TObject); begin DemanderExportPlanToSVG(); end; procedure TfrmVueEnPlan.acF2DExtractProfilTerrainExecute(Sender: TObject); begin if (GHTopoContext2DA1.CanDraw and GHTopoContext2DA1.IsMaillageDisplayed(0)) then begin GHTopoContext2DA1.SetModeTravail(mtPROFIL_MNT_PREMIER_POINT); GHTopoContext2DA1.RefreshDessin(); end else ShowMessage('Maillage MNT invalide, non chargé ou non tracé'); end; procedure TfrmVueEnPlan.acCreerTimelapseExecute(Sender: TObject); var QDirectory: string; begin if (SelectDirectory(GetResourceString(rsCDR_VUE2D_CREATE_TIMELAPSE), GetGHTopoDirectory(), QDirectory)) then begin GHTopoContext2DA1.CreerTimeLapse(QDirectory); end; end; procedure TfrmVueEnPlan.acDeleteAnnotationExecute(Sender: TObject); begin GHTopoContext2DA1.SetModeTravail(mtDELETE_ANNOTATION); end; procedure TfrmVueEnPlan.acDeletePolylineExecute(Sender: TObject); begin GHTopoContext2DA1.SetModeTravail(mtDELETE_POLYLINE); end; procedure TfrmVueEnPlan.acExportPlanEnPNGExecute(Sender: TObject); const IMG_WIDTH_MIN = 1600; IMG_WIDTH_MAX = 32000; var TD: TSavePictureDialog; C1, C2: TPoint3Df; dx, dy, r: Double; IW: Integer; IH: Int64; EWE: string; begin EWE := '12000'; if (InputQuery('Export du plan en image', 'Largeur de l''image', EWE)) then begin IW := StrToIntDef(Trim(EWE), IMG_WIDTH_MIN); if (IW < IMG_WIDTH_MIN) then IW := IMG_WIDTH_MIN; if (IW > IMG_WIDTH_MAX) then IW := IMG_WIDTH_MAX; TD := TSavePictureDialog.Create(self); try TD.InitialDir := GetGHTopoDirectory(); TD.FileName := 'ImgPlan001.png'; TD.DefaultExt := '.png'; TD.Options := TD.Options + [ofOverwritePrompt]; if (TD.Execute) then begin C1 := FBDDEntites.CoinBasGauche; C2 := FBDDEntites.CoinHautDroit; dx := C2.X - C1.X; dy := C2.Y - C1.Y; r := dy / dx; IH := trunc(IW * r); GHTopoContext2DA1.ExporterPlanEnImage(IW, IH, true, TD.FileName); ShowMessage(GetResourceString(rsDONE_ANY_PROCESS)); end; finally FreeAndNil(TD); end; end; end; procedure TfrmVueEnPlan.acF2DCalculerLeReseauExecute(Sender: TObject); begin if (Assigned(FProcRecalculerReseau)) then begin FProcRecalculerReseau(false); chkTopoNavig.Checked := false; end; end; procedure TfrmVueEnPlan.acF2DLocaliserStationExecute(Sender: TObject); begin GHTopoContext2DA1.LocaliserUneStation(); end; procedure TfrmVueEnPlan.acF2DPanVueExecute(Sender: TObject); begin if (GHTopoContext2DA1.CanDraw) then GHTopoContext2DA1.SetModeTravail(mtPAN_PREMIER_POINT); end; procedure TfrmVueEnPlan.acF2DParamOngletExecute(Sender: TObject); var n: Integer; MyOnglet: TVue2DParams; begin if (not GHTopoContext2DA1.CanDraw) then exit; n := GHTopoContext2DA1.GetCurrentOngletIdx(); MyOnglet := GHTopoContext2DA1.GetOngletByIndex(n); if (ParametrerOngletVue2D(MyOnglet)) then GHTopoContext2DA1.PutOngletByIndex(n, MyOnglet, True); end; procedure TfrmVueEnPlan.acF2DPrintPlanExecute(Sender: TObject); begin DisplayCentreImpressionExt(FDocTopo, FBDDEntites, GHTopoContext2DA1.GetPtrCroquisTerrain(), {$IFNDEF GHTOPO_SIMPLIFIE} FListeOfMaillages, {$ENDIF GHTOPO_SIMPLIFIE} GetParamsOngletCourant()); end; procedure TfrmVueEnPlan.acF2DZoomAllExecute(Sender: TObject); begin if (GHTopoContext2DA1.CanDraw) then GHTopoContext2DA1.ResetVue(); end; procedure TfrmVueEnPlan.acF2DZoomFenetreExecute(Sender: TObject); begin if (GHTopoContext2DA1.CanDraw) then GHTopoContext2DA1.SetModeTravail(mtZOOM_PREMIER_COIN); end; procedure TfrmVueEnPlan.acF2DZoomMoinsExecute(Sender: TObject); begin if (GHTopoContext2DA1.CanDraw) then GHTopoContext2DA1.ZoomFact(1 - 0.05); end; procedure TfrmVueEnPlan.acF2DZoomPlusExecute(Sender: TObject); begin if (GHTopoContext2DA1.CanDraw) then GHTopoContext2DA1.ZoomFact(1 + 0.05); end; procedure TfrmVueEnPlan.acShowFenetreConsoleExecute(Sender: TObject); begin {$IFDEF DISP_FRM_JOURNAL} PositionnerFenetre(dlgProcessing, 10, 120, 500, Screen.Height - 230); dlgProcessing.SetFocus; {$ENDIF} end; procedure TfrmVueEnPlan.acShowFenetreListeSimplesExecute(Sender: TObject); begin PositionnerFenetre(frmListesSimples, 10, 140, Screen.Width - 500, Screen.Height - 300); frmListesSimples.SetFocus; end; procedure TfrmVueEnPlan.acShowFenetreSeriesExecute(Sender: TObject); begin PositionnerFenetre(frmGestionSeries, 20, 120, Screen.Width - 300, Screen.Height - 260); frmGestionSeries.SetFocus; end; procedure TfrmVueEnPlan.btnExchangeClick(Sender: TObject); var EWE: TCaption; begin EWE := btnStationDepart.Caption; btnStationDepart.Caption := btnStationArrivee.Caption; btnStationArrivee.Caption := EWE; RecalculerShortestPath(btnStationDepart.Caption, btnStationArrivee.Caption); end; procedure TfrmVueEnPlan.btnExportHTMLClick(Sender: TObject); var FDisplayDevices: TArrayOfDisplayDevices; QMenuWidth, n, i: Integer; QDestDirectory: TStringDirectoryFilename; PD: TDisplayDevice; QFilename: String; // Recenser les displays procedure RecenserDisplays(); var m, NbMonitors: Integer; MyMonitor: TMonitor; begin NbMonitors := Screen.MonitorCount; FDisplayDevices.Redim(0); for m:= 0 to NbMonitors - 1 do begin MyMonitor := Screen.Monitors[m]; FDisplayDevices.AppendFrom(BoolToStr(MyMonitor.Primary, 'Primary', 'Auxiliary'), MyMonitor.Width, MyMonitor.Height); end; FDisplayDevices.AppendFrom('SVGA' , 1280, 1024); FDisplayDevices.AppendFrom('Tablette 7 - 10 inch' , 1024, 600); FDisplayDevices.AppendFrom('Tablette Lenovo M10 HD', 1280, 800); // Galaxy Tab 10,1 1280×800 end; begin QMenuWidth := 200; QDestDirectory := GetGHTopoDirectory() + MON_DOSSIER_GRAPHES + PathDelim; ForceDirectoriesUTF8(QDestDirectory); RecenserDisplays(); n := FDisplayDevices.getNbElements(); for i := 0 to n-1 do begin PD := FDisplayDevices.getElement(i); QFilename := format('%s_%dx%d.htm', [FDocTopo.GetNomEtude(), PD.Width, PD.Height]); FGraphe.ExporterGrapheEnJavascript('Graphe du réseau de ' + FDocTopo.GetNomEtude(), QDestDirectory + QFileName, btnStationDepart.Caption, btnStationArrivee.Caption, clCream, clRed, 100.00);//, //PD.Width, PD.Height, QMenuWidth); end; ShowMessage(GetResourceString(rsDONE_ANY_PROCESS)); // Ouverture du dossier contenant les graphes OpenDocument(QDestDirectory); // Ouverture dans le navigateur for i := 0 to n-1 do begin PD := FDisplayDevices.getElement(i); QFilename := format('%s_%dx%d.htm', [FDocTopo.GetNomEtude(), PD.Width, PD.Height]); LCLIntf.OpenDocument(QDestDirectory +QFilename); end; end; procedure TfrmVueEnPlan.btnPathPreviousClick(Sender: TObject); begin lsbPathRoadMap.ItemIndex := lsbPathRoadMap.ItemIndex - 1; if (lsbPathRoadMap.ItemIndex >= 0) then lsbPathRoadMapChange(self) else lsbPathRoadMap.ItemIndex := 0; end; procedure TfrmVueEnPlan.btnPathNextClick(Sender: TObject); begin lsbPathRoadMap.ItemIndex := lsbPathRoadMap.ItemIndex + 1; if (lsbPathRoadMap.ItemIndex < lsbPathRoadMap.Items.Count) then lsbPathRoadMapChange(self) else lsbPathRoadMap.ItemIndex := lsbPathRoadMap.Items.Count - 1; end; procedure TfrmVueEnPlan.btnPickPathStationArrClick(Sender: TObject); begin btnStationArrivee.Caption := GHTopoContext2DA1.GetCurrentStationNearToMousePos().toString(); btnStationArriveeClick(self); end; procedure TfrmVueEnPlan.btnPickPathStationDepClick(Sender: TObject); begin btnStationDepart.Caption := GHTopoContext2DA1.GetCurrentStationNearToMousePos().toString(); btnStationDepartClick(self); end; procedure TfrmVueEnPlan.btnStationArriveeClick(Sender: TObject); var EWE: TCaption; begin EWE := btnStationArrivee.Caption; if (SaisirIDStation('Arrivée', EWE)) then begin if (RecalculerShortestPath(btnStationDepart.Caption, EWE)) then btnStationArrivee.Caption := EWE; end; end; procedure TfrmVueEnPlan.btnStationDepartClick(Sender: TObject); var EWE: TCaption; begin EWE := btnStationDepart.Caption; if (SaisirIDStation('Départ', EWE)) then begin if (RecalculerShortestPath(EWE, btnStationArrivee.Caption)) then btnStationDepart.Caption := EWE; end; end; procedure TfrmVueEnPlan.btnStyleObjet0Click(Sender: TObject); begin SetPanelStyles(0); end; procedure TfrmVueEnPlan.btnStyleObjet10Click(Sender: TObject); begin SetPanelStyles(10); end; procedure TfrmVueEnPlan.btnStyleObjet1Click(Sender: TObject); begin SetPanelStyles(1); end; procedure TfrmVueEnPlan.btnStyleObjet2Click(Sender: TObject); begin SetPanelStyles(2); end; procedure TfrmVueEnPlan.btnStyleObjet3Click(Sender: TObject); begin SetPanelStyles(3); end; procedure TfrmVueEnPlan.btnStyleObjet4Click(Sender: TObject); begin SetPanelStyles(4); end; procedure TfrmVueEnPlan.btnStyleObjet5Click(Sender: TObject); begin SetPanelStyles(5); end; procedure TfrmVueEnPlan.btnStyleObjet6Click(Sender: TObject); begin SetPanelStyles(6); end; procedure TfrmVueEnPlan.btnStyleObjet7Click(Sender: TObject); begin SetPanelStyles(7); end; procedure TfrmVueEnPlan.btnStyleObjet8Click(Sender: TObject); begin SetPanelStyles(8); end; procedure TfrmVueEnPlan.btnStyleObjet9Click(Sender: TObject); begin SetPanelStyles(9); end; procedure TfrmVueEnPlan.btnSelectItineraireClick(Sender: TObject); var QIti: TPathBetweenNodes; S1, S2, EWE: String; begin S1 := btnStationDepart.Caption; S2 := btnStationArrivee.Caption; EWE := format('Itineraire_%d', [FGraphe.GetNbItineraires() + 1]); if (SelectItineraire(FGraphe, S1, S2, EWE, QIti)) then begin ShowMessage(QIti.NomItineraire); btnStationDepart.Caption := QITI.StationDepartToTBaseStation().toString(); btnStationArrivee.Caption := QIti.StationArriveeToTBaseStation().toString(); RecalculerShortestPath(btnStationDepart.Caption, btnStationArrivee.Caption); end; end; procedure TfrmVueEnPlan.ChangeAttrElementsAffiches(const QIdx: TElementDrawn; const QChecked: boolean); var n: Integer; MyOnglet: TVue2DParams; procedure MiouMiou(const Miou: TElementDrawn); begin if (QChecked) then Include(MyOnglet.ongElementsDrawn, Miou) else Exclude(MyOnglet.ongElementsDrawn, Miou); end; begin if (not GHTopoContext2DA1.CanDraw) then exit; n := GHTopoContext2DA1.GetCurrentOngletIdx(); MyOnglet := GHTopoContext2DA1.GetOngletByIndex(n); MiouMiou(QIdx); GHTopoContext2DA1.PutOngletByIndex(n, MyOnglet, True); end; procedure TfrmVueEnPlan.DispAttrElementsAffiches(const EA: TSetElementsDrawn); begin chkPolygonales.Checked := edPolygonals in EA; chkSections.Checked := edCrossSections in EA; chkRemplissage.Checked := edFillGalerie in EA; chkAntennes.Checked := edANTENNES in EA; chkAltitudes.Checked := edAltitudes in EA; chkCotes.Checked := edCotes in EA; chkEntrances.Checked := edENTRANCE_MKS in EA; chkEntranceNames.Checked := edENTRANCE_NAMES in EA; chkStations.Checked := edStations in EA; chkIDStations.Checked := edIDStations in EA; chkNoeuds.Checked := edJONCTIONS in EA; chkParois.Checked := edWalls in EA; end; procedure TfrmVueEnPlan.chkAltitudesChange(Sender: TObject); begin ChangeAttrElementsAffiches(edAltitudes, chkAltitudes.Checked); end; procedure TfrmVueEnPlan.chkAntennesChange(Sender: TObject); begin ChangeAttrElementsAffiches(edANTENNES, chkAntennes.Checked); end; procedure TfrmVueEnPlan.chkCotesChange(Sender: TObject); begin ChangeAttrElementsAffiches(edCotes, chkCotes.Checked); end; procedure TfrmVueEnPlan.chkEntranceNamesChange(Sender: TObject); begin ChangeAttrElementsAffiches(edENTRANCE_NAMES, chkEntranceNames.Checked); end; procedure TfrmVueEnPlan.chkEntrancesChange(Sender: TObject); begin ChangeAttrElementsAffiches(edENTRANCE_MKS, chkEntrances.Checked); end; procedure TfrmVueEnPlan.chkIDStationsChange(Sender: TObject); begin ChangeAttrElementsAffiches(edIDStations, chkIDStations.Checked); end; procedure TfrmVueEnPlan.chkNoeudsChange(Sender: TObject); begin ChangeAttrElementsAffiches(edJONCTIONS, chkNoeuds.Checked); end; procedure TfrmVueEnPlan.chkParoisChange(Sender: TObject); begin ChangeAttrElementsAffiches(edWalls, chkParois.Checked); end; procedure TfrmVueEnPlan.chkPOIChange(Sender: TObject); begin ChangeAttrElementsAffiches(edPOI, chkPOI.Checked); end; procedure TfrmVueEnPlan.chkPolygonalesChange(Sender: TObject); begin ChangeAttrElementsAffiches(edPolygonals, chkPolygonales.Checked); end; procedure TfrmVueEnPlan.chkRemplissageChange(Sender: TObject); begin ChangeAttrElementsAffiches(edFillGalerie, chkRemplissage.Checked); end; procedure TfrmVueEnPlan.chkSectionsChange(Sender: TObject); begin ChangeAttrElementsAffiches(edCrossSections, chkSections.Checked); end; procedure TfrmVueEnPlan.chkStationsChange(Sender: TObject); begin ChangeAttrElementsAffiches(edStations, chkStations.Checked); end; procedure TfrmVueEnPlan.chkTopoNavigChange(Sender: TObject); begin if (chkTopoNavig.Checked) then SetModeFonctionnement(mfgcNAVIGATION) else SetModeFonctionnement(mfgcSURVEYING); end; procedure TfrmVueEnPlan.FormClose(Sender: TObject; var CloseAction: TCloseAction); begin GHTopoContext2DA1.FinaliserOnParentClose(); end; procedure TfrmVueEnPlan.acF2DStatistiquesExecute(Sender: TObject); begin DisplayStatistiquesExt(FDocTopo, FBDDEntites, self.getMetaFiltre()); end; procedure TfrmVueEnPlan.acF2DVue3DExecute(Sender: TObject); begin DisplayVue3DGDI(FDocTopo, FBDDEntites, FListeOfMaillages, GHTopoContext2DA1.getMetaFiltre()); GHTopoContext2DA1.RefreshDessin(); end; procedure TfrmVueEnPlan.acFermerUnCheminementExecute(Sender: TObject); begin if (GHTopoContext2DA1.CanDraw) then GHTopoContext2DA1.SetModeTravail(mtBOUCLER_PREMIER_POINT); end; procedure TfrmVueEnPlan.acLoadMaillageExecute(Sender: TObject); begin DemanderChargementDeMNT(); end; procedure TfrmVueEnPlan.acNewAnnotationExecute(Sender: TObject); begin GHTopoContext2DA1.SetModeTravail(mtNEW_ANNOTATION); end; procedure TfrmVueEnPlan.acNewPolyligneExecute(Sender: TObject); begin GHTopoContext2DA1.SetModeTravail(mtNEW_POLYLINE); end; procedure TfrmVueEnPlan.acOpenCroquisExecute(Sender: TObject); var FC: TCroquisTerrain; QFilename: TStringDirectoryFilename; begin QFilename := ''; FC := GHTopoContext2DA1.GetPtrCroquisTerrain(); if (DoDialogOpenFile(GetGHTopoDirectory(), 'Croquis (*.xml)|*.xml', '.xml', QFilename)) then begin FC.LoadFromXML(QFilename); GHTopoContext2DA1.SetModeTravail(mtREADY); GHTopoContext2DA1.RefreshDessin(); end; end; procedure TfrmVueEnPlan.acSaveAsExecute(Sender: TObject); var QFileName: TStringDirectoryFilename; QFilterIndex: integer; begin QFileName := FCurrentNomFichierXTB; if (DoDialogSaveFile(GetResourceString(rsGHTOPO_SAVE_FILE_FILTER), '.xtb', QFileName, QFilterIndex)) then begin case QFilterIndex of 1: FDocTopo.SaveToXTB(QFileName, mtabEXTENDEDTAB, tfWINDOWS); // 'Fichiers GHTopo (*.xtb)|*.xtb' 2: FDocTopo.SaveToXML(QFileName); // futur format standard de GHTopo // 'Fichiers GHTopo XML (*.gtx)|*.gtx' 3: FDocTopo.SaveToXTB(QFileName, mtabTOPOROBOT , tfMAC); // 'Fichiers Toporobot Tab [deprecated] (*.Tab)|*.Tab' 4: FDocTopo.ExporterVersToporobotTEXT(QFileName, SEUIL_LONGUEUR_MAXI_TOPOROBOT, false); //FDocTopo.; // 'Fichiers PocketTopo TXT (*.txt)|*.txt' 5: FDocTopo.SaveToJSON(QFileName); // 'Fichiers GHTopo JSON (expérimental)|*.json' 6: QExportVisualTopo(QFileName); // 'Fichiers VisualTopo TROX (*.trox)|*.trox' //7: FDocTopo.ExportVersSurvexOrTherion(QFileName, svxSURVEX); // 'Fichiers Survex SVX (expérimental)|*.svx' + '|' + end; // case FilterIndex // actualisation du nouveau nom de fichier FCurrentNomFichierXTB := QFileName; self.Caption := MakeTitleMainWindowGHTopo(FDocTopo.GetNomEtude(), FCurrentNomFichierXTB); end; end; procedure TfrmVueEnPlan.QExportVisualTopo(const QFilename: TStringDirectoryFilename); var TD: TUtilsVisualTopo; begin TD := TUtilsVisualTopo.Create; try if (TD.Initialiser(FDocTopo, nil)) then TD.ExportVisualTopoTROX(QFilename, true); ShowMessageFmt('%s: %s(%s)', [GetResourceString(rsDONE_ANY_PROCESS), 'ExportVisualTopoTROX', QFilename]); finally FreeandNil(TD); end; end; procedure TfrmVueEnPlan.acSaveCroquisExecute(Sender: TObject); var QFilename: TStringDirectoryFilename; QIdx: integer; FC: TCroquisTerrain; begin QFilename := 'croquis001.xml'; if (DoDialogSaveFile('Fichier croquis (*.xml)|*.xml', '.xml', QFilename, QIdx)) then begin FC := GHTopoContext2DA1.GetPtrCroquisTerrain(); FC.SaveToXML(QFilename); end; end; procedure TfrmVueEnPlan.Finaliser(); begin pass; end; function TfrmVueEnPlan.GetParamsOngletCourant(): TVue2DParams; var n: Integer; begin n := GHTopoContext2DA1.GetCurrentOngletIdx(); Result := GHTopoContext2DA1.GetOngletByIndex(n); end; procedure TfrmVueEnPlan.PutParamsOngletCourant(const O: TVue2DParams); var n: Integer; begin n := GHTopoContext2DA1.GetCurrentOngletIdx(); GHTopoContext2DA1.PutOngletByIndex(n, O, True); end; function TfrmVueEnPlan.GetMaillage(const Idx: integer): TMaillage; begin Result := FListeOfMaillages.GetElement(Idx); end; procedure TfrmVueEnPlan.CentrerBasepointSurPlan(const BP: TToporobotIDStation); begin GHTopoContext2DA1.LocaliserUneStationByCle(BP.ToString()); end; procedure TfrmVueEnPlan.CentrerXYSurPlan(const QX, QY: double; const TagString: string); begin GHTopoContext2DA1.CentrerVueSurPointXY(QX, QY, True, TagString); end; procedure TfrmVueEnPlan.CentrerNearStSurPlan(const NearST: TStationProcheOfEndSerie); var BP: TBaseStation; begin GHTopoContext2DA1.SetCurrentNearSt(NearST); FBDDEntites.GetEntiteViseeFromSerSt(NearST.BaseStation.aSerie, NearST.BaseStation.aStation, BP); GHTopoContext2DA1.CentrerVueSurPointXY(BP.PosStation.X, BP.PosStation.Y, false, '-'); end; procedure TfrmVueEnPlan.CentrerBipointSurPlan(const BP: TBipointBaseStation); var MP: TPoint3Df; begin MP := BP.MidPoint(); GHTopoContext2DA1.SetCurrentBipoint(BP); GHTopoContext2DA1.CentrerVueSurPointXY(MP.X, MP.Y, false, '-'); end; procedure TfrmVueEnPlan.DemanderChargementDeMNT(); var QFilename: TStringDirectoryFilename; begin FProcProgression := self.ProcDisplayProgression(); try QFilename:= ''; if (GHTopoContext2DA1.IsMaillageValide(0)) then begin if (Not GHTopoQuestionOuiNon('Un maillage valide existe. Le remplacer')) then exit; end; if (DoDialogOpenFile('Fichiers maillage (*.mai)|*.mai', '.mai', QFilename)) then begin pnlProgression.Visible := True; GHTopoContext2DA1.ChargerMaillage(QFilename, FProcProgression); pnlProgression.Visible := false; end; finally FProcProgression := nil; end; end; procedure TfrmVueEnPlan.ActiverPanelMaillage; begin GHTopoContext2DA1.ActiverPanelMaillage(); end; procedure TfrmVueEnPlan.DemanderExportPlanToSVG(); var QFilename: TStringDirectoryFilename; O: TVue2DParams; QFilterIndex: integer; begin QFilename := 'Plan2D_SVG.svg'; if (DoDialogSaveFile('Scalable Vectors Graphics (SVG)|*.svg', '.svg', QFilename, QFilterIndex)) then begin pnlProgression.Visible := True; O := GHTopoContext2DA1.GetCurrentOnglet(); FBDDEntites.ExportVue2DSVG(QFilename, false, O, ProcDisplayProgression); pnlProgression.Visible := False; end; end; function TfrmVueEnPlan.getListeSeriesSelectionnees(): string; begin result := CdrListesPourVisualisateurs1.getListeSeriesSelectionnees(); end; function TfrmVueEnPlan.getMetaFiltre: string; begin result := GHTopoContext2DA1.getMetaFiltre(); end; procedure TfrmVueEnPlan.setDoIncludeVerticales(const B: boolean); begin FDoIncludeVerticales := B; GHTopoContext2DA1.setDoIncludeVerticales(B); end; procedure TfrmVueEnPlan.FormCloseQuery(Sender: TObject; var CanClose: boolean); begin CanClose := false; end; procedure TfrmVueEnPlan.FormCreate(Sender: TObject); begin pass; end; procedure TfrmVueEnPlan.FormResize(Sender: TObject); begin PairSplitterSide1.Width := self.Width - 400; end; procedure TfrmVueEnPlan.FormShow(Sender: TObject); begin GHTopoContext2DA1.InitialiserOnParentShow(); GHTopoContext2DA1.ResetVue(); end; procedure TfrmVueEnPlan.FormWindowStateChange(Sender: TObject); const GHTOPO_MAIN_BAR_HEIGHT = 90; DESKTOP_TASKBAR_HEIGHT = 80; begin if (self.WindowState = wsMaximized) then begin self.Left := 0; self.Top := GHTOPO_MAIN_BAR_HEIGHT; // 1 + Hauteur de la fenêtre principale self.Width := Screen.Width; self.Height := Screen.Height - self.Top - DESKTOP_TASKBAR_HEIGHT - 4; end; end; procedure TfrmVueEnPlan.lsbPathRoadMapChange(Sender: TObject); begin DisplayBearingToNext(lsbPathRoadMap.ItemIndex); end; procedure TfrmVueEnPlan.InitCaptions(); procedure SetAcHint(const ACDC: TAction; const QCaption: string); var WU: String; begin WU := EnlevePerluete(GetResourceString(QCaption)); ACDC.Caption := WU; ACDC.Hint := WU; end; begin SetAcHint(acSaveAs , rsSAVEAS); SetAcHint(acF2DPrintPlan , rsVUE2D_PRINTING); SetAcHint(acF2DVue3D , rsVUE2D_VUE3D_GDI); SetAcHint(acF2DZoomAll , rsCDR_VUE2D_AC_ZOOM_ALL); SetAcHint(acF2DZoomFenetre , rsCDR_VUE2D_AC_ZOOM_WINDOW); SetAcHint(acF2DPanVue , rsCDR_VUE2D_AC_PAN_VUE); SetAcHint(acF2DZoomPlus , 'Zoom +'); SetAcHint(acF2DZoomMoins , 'Zoom -'); SetAcHint(acF2DParamOnglet , rsCDR_VUE2D_AC_PARAM_ONGLET); //SetAcHint(acAddSerieHere , rsCDR_VUE2D_ADD_SERIE_HERE); SetAcHint(acF2DDistance , rsCDR_VUE2D_AC_DISTANCE_BT_STATIONS); SetAcHint(acF2DLocaliserStation , rsCDR_VUE2D_LOCALISER_STATION); SetAcHint(acF2DStatistiques , rsSTATISTIQUES_TITRE); SetAcHint(acShowFenetreSeries , rsWND_DATABASE); SetAcHint(acShowFenetreListeSimples , rsWND_LISTES_SIMPLES); SetAcHint(acShowFenetreConsole , rsWND_CONSOLE); SetAcHint(acCreerTimelapse , rsCDR_VUE2D_CREATE_TIMELAPSE); SetAcHint(acFermerUnCheminement , rsCDR_VUE2D_CLOSE_BOUCLE); SetAcHint(acF2DExportSVG , rsEXPORT_SVG); SetAcHint(acF2DCalculerLeReseau , rsCOMPILE); SetAcHint(acLoadMaillage , rsCDR_VUE2D_AC_LOAD_MNT); SetAcHint(acF2DExtractProfilTerrain , rsCDR_VUE2D_EXTRACT_PROFIL_FROM_MNT); SetAcHint(acOpenCroquis , rsCDR_VUE2D_AC_CROQUIS_OPEN); SetAcHint(acSaveCroquis , rsCDR_VUE2D_AC_CROQUIS_SAVE); SetAcHint(acNewAnnotation , rsCDR_VUE2D_AC_CROQUIS_NEW_ANNOTATION); SetAcHint(acNewPolyligne , rsCDR_VUE2D_AC_CROQUIS_NEW_POLYLIGNE); SetAcHint(acDeleteAnnotation , rsCDR_VUE2D_AC_CROQUIS_DELETE_ANNOTATION); SetAcHint(acDeletePolyline , rsCDR_VUE2D_AC_CROQUIS_DELETE_POLYLIGNE); end; procedure TfrmVueEnPlan.PerformActionWithBaseStation(const BP: TBaseStation; const TodoAction: TTodoAction); var MySerie: TObjSerie; QIdx: integer; begin case TodoAction of tdoAcnBASESTATION_DISPLAY: begin ShowMessage(Format('En attente: Traitement de %d.%d', [BP.Entite_Serie, BP.Entite_Station])); end; tdoAcnBASESTATION_EDITSERIE: begin if (FDocTopo.GetSerieByNumeroSerie(BP.Entite_Serie, MySerie, QIdx)) then begin if (DisplayUneSerieAsGrid(FDocTopo, FBDDEntites, QIdx, MySerie)) then begin pass; //FDocumentToporobot.CheckerLesDonneesTopo(); end; end; end; tdoAcnBASESTATION_ADD_TO_HIGHLIGHT: begin if (FDocTopo.GetSerieByNumeroSerie(BP.Entite_Serie, MySerie, QIdx)) then begin CdrListesPourVisualisateurs1.AddNumSerieARetenir(BP.Entite_Serie); end; end; end; end; procedure TfrmVueEnPlan.PerformActionWithTwoBaseStation(const ST1, ST2: TBaseStation); begin //ShowMessageFmt('ST1: %s - ST2: %s', [ST1.toString(), ST2.toString()]); if (GHTopoContext2DA1.ModeFonctionnementGHTopoContext2D = mfgcNAVIGATION) then begin btnStationDepart.Caption := ST1.toString(); btnStationArrivee.Caption := ST2.toString(); RecalculerShortestPath(ST1.toString(), ST2.toString()); end; end; function TfrmVueEnPlan.InitialiserVue2D(const D: TToporobotStructure2012; const C: TCroquisTerrain; const P: TBDDEntites; const AM: TListeOfMaillages; const G: TPathFindingGraphe; const CheminMinimal: TPathBetweenNodes; const QFileName: TStringDirectoryFilename; const QProcRecalcul: TProcOfObjectWithOneBoolParameter; const DoIncludeVerticales: boolean): boolean; begin AfficherMsgClass(self, 'InitialiserVue2D()'); result := false; FBDDEntites := P; FDocTopo := D; FListeOfMaillages := AM; FGraphe := G; FShortestPath := CheminMinimal; FDoIncludeVerticales := DoIncludeVerticales; FCurrentNomFichierXTB := QFileName; pnlProgression.Visible:= false; pnlOutilsDessin.Visible := (C.IsReady); // init cadre vue 2D InitCaptions(); //GHTopoContext2DA1.Finaliser(); GHTopoContext2DA1.ReInitialiser(mfgcSURVEYING, FDocTopo, // const QDT: TToporobotStructure2012; FBDDEntites, // const QBDD: TBDDEntites; C, // const QCT: TCroquisTerrain; FGraphe, FShortestPath, FListeOfMaillages, // const QMaillage: TMaillage; nil, // const QProcUseMetaFiltre: TProcedureOfObject; nil, // const QProcRefresh: TProcOfObjectWithOneBoolParameter; QProcRecalcul, PerformActionWithBaseStation, PerformActionWithTwoBaseStation, FDoIncludeVerticales); PreparerVues(); CdrListesPourVisualisateurs1.InitialiseListeSelection(FDocTopo, FBDDEntites, GHTopoContext2DA1, mslSERIE, 1, false, true); FProcRecalculerReseau := QProcRecalcul; // panneau graphe: invisible par défaut SetModeFonctionnement(mfgcSURVEYING); btnStationDepart.Caption := '1.1'; btnStationArrivee.Caption := '1.1'; FShortestPath.Initialiser(1, 1, 1, 1, '', clRed); // et on recadre la vue if (GHTopoContext2DA1.CanDraw) then GHTopoContext2DA1.ResetVue(); result := true; end; procedure TfrmVueEnPlan.setProcProgression(const P: TProcDisplayProgression); begin FProcProgression := P; end; procedure TfrmVueEnPlan.OngletsVuesChange(Sender: TObject); var MyOnglet: TVue2DParams; begin GHTopoContext2DA1.SetCurrentIdxOnglet(OngletsVues.TabIndex); MyOnglet := GHTopoContext2DA1.GetCurrentOnglet(); DispAttrElementsAffiches(MyOnglet.ongElementsDrawn); end; procedure TfrmVueEnPlan.PreparerVues(); var o: Integer; Ong: TVue2DParams; begin OngletsVues.Tabs.Clear; // préparation des OngletsVues for o := 0 to GHTopoContext2DA1.GetNbOngletsVues() - 1 do begin Ong := GHTopoContext2DA1.GetOngletByIndex(o); OngletsVues.Tabs.Add(Ong.ongName); end; OngletsVues.TabIndex := 0; // indicateur croquis de terrain lbStatutCroquisTerrain.Color := IIF(GHTopoContext2DA1.CroquisDeTerrainIsReady(), clGreen, clRed); // préparer le panneau de styles de polylignes/annotations du croquis SetPanelStyles(ord(GHTopoContext2DA1.GetPtrCroquisTerrain().TypePolylinePolygone)); // et renseigner les checkbox éléments dessinés Ong := GHTopoContext2DA1.GetOngletByIndex(0); DispAttrElementsAffiches(Ong.ongElementsDrawn); end; // panneau des styles de polylignes/textes procedure TfrmVueEnPlan.SetPanelStyles(const QCurrStyleIdx: integer); var FC: TCroquisTerrain; i: Integer; procedure MiouMiou(const Miou: TStaticText; const SP: TKrobardStylePolyligne; const QSelected: boolean); var EWE: Boolean; begin EWE := (kfpCLOSED in SP.Flags) OR (kfpFILLED in SP.Flags); Miou.Caption := BoolToStr(QSelected, 'X', ''); Miou.Hint := Format('%s [Poly%s]', [SP.Name, BoolToStr(EWE, 'gone', 'ligne')]); if (EWE) then begin Miou.BorderStyle := sbsSingle; Miou.Color := SP.FillColor; Miou.BorderWidth := 5; end else begin Miou.BorderStyle := sbsNone; Miou.Color := SP.LineColor; Miou.BorderWidth := 1; end; end; begin FC := GHTopoContext2DA1.GetPtrCroquisTerrain(); FC.SetCurrentStylePolyligne(TKrobardTypePolylinePolygone(QCurrStyleIdx)); for i := 0 to 9 do MiouMiou(TStaticText(self.FindComponent(Format('btnStyleObjet%d', [i]))), FC.GetStylePolyligne(i), (Ord(FC.TypePolylinePolygone) = i)); end; // graphe procedure TfrmVueEnPlan.SetModeFonctionnement(const MF: TModeFonctionnementGHTopoContext2D); var EWE: TBaseStation; begin case MF of mfgcSURVEYING : begin pnlGrapheReseau.Visible := false; // et on centre sur la station courante EWE := GHTopoContext2DA1.GetCurrentStation(); GHTopoContext2DA1.CentrerVueSurPointXY(EWE.PosStation.X, EWE.PosStation.Y, True, EWE.ToString()); CdrBoussole1.Initialiser(360.00, 360.00, clSilver, $0082FFFF, clRed); end; mfgcNAVIGATION: begin pnlGrapheReseau.Visible := true; AfficherMessage('Construction du graphe'); FGraphe.ConstruireGraphe(FDoIncludeVerticales, false); RecalculerShortestPath(btnStationDepart.Caption, btnStationArrivee.Caption); end; end; GHTopoContext2DA1.SetModeFonctionnement(MF); end; function TfrmVueEnPlan.RecalculerShortestPath(const StationDepart, StationArrivee: string): boolean; var EE1, EE2: TBaseStation; Q1, Q2 : Boolean; Nb, i : Integer; MyNode : TBZClassNode; SPArr: TAbsoluteIndexCumul; begin result := false; Q1 := FBDDEntites.FindStationByCle(false, Trim(StationDepart) , EE1); Q2 := FBDDEntites.FindStationByCle(false, Trim(StationArrivee), EE2); if (not Q1) then begin ShowMessageFmt(GetResourceString(rsMSG_GRAPHE_POINT_NOT_FOUND), ['début', StationDepart]); Exit; end; if (not Q2) then begin ShowMessageFmt(GetResourceString(rsMSG_GRAPHE_POINT_NOT_FOUND), ['fin', StationArrivee]); Exit; end; FShortestPath.Initialiser(EE1.Entite_Serie, EE1.Entite_Station, EE2.Entite_Serie, EE2.Entite_Station, 'Vers la sortie', clRed); if (FGraphe.RechercherPlusCourtChemin(FShortestPath)) then begin Nb := FShortestPath.GetNbNoeuds(); lbNbPathStations.caption := format('%d stations (%.0f m)', [Nb, FShortestPath.LongueurParcours]); lsbPathRoadMap.Clear; for i := 0 to Nb - 1 do begin SPArr := FShortestPath.GetNoeud(i); MyNode := FGraphe.GetStation(SPArr.Index); lsbPathRoadMap.Items.add(MyNode.ToString()); end; lsbPathRoadMap.ItemIndex := 0; GHTopoContext2DA1.SetShortestPath(FShortestPath); GHTopoContext2DA1.RefreshDessin(); result := True; end; end; procedure TfrmVueEnPlan.DisplayBearingToNext(const IdxWpt: integer); var n: Integer; WptCurr, WptNext: TBZClassNode; qdx, qdy, qdz, QDist, QAz, QIncl: Double; begin lbNextWpt.Caption := '---'; lbNextWptAzimut.Caption := '---'; n := FShortestPath.GetNbNoeuds(); if (0 = n) then Exit; if (IdxWpt = (n-1)) then begin lbNextWpt.Caption := 'Finish'; Exit; end; WptCurr := FGraphe.GetStation(FShortestPath.GetNoeud(IdxWpt).Index); WptNext := FGraphe.GetStation(FShortestPath.GetNoeud(IdxWpt+1).Index); lbNextWpt.Caption := WptNext.ToString(); qdx := WptNext.Position.X - WptCurr.Position.X; qdy := WptNext.Position.Y - WptCurr.Position.Y; qdz := WptNext.Position.Z - WptCurr.Position.Z; GetBearingIncFromDeltaXYZ(360.00, 360.00, qdx, qdy, qdz, QDist, QAz, QIncl); lbNextWptAzimut.Caption := FormatterNombreAvecSepMilliers(QAz , 3) + ' °'; lbNextWptDistance.Caption := FormatterNombreAvecSepMilliers(QDist, 3) + ' m'; // et on centre la carte sur le point sans modifier la station courante GHTopoContext2DA1.CentrerVueSurPointXY(WptNext.Position.X, WptNext.Position.Y, True, WptNext.ToString()); CdrBoussole1.SetAzimut(QAz); end; end.