unit ToporobotClasses2012; {$INCLUDE CompilationParameters.inc} //**************************************************** // Projet : GHTopo // Modules : Classe pour gestion des données TOPOROBOT // Licence : General Public License - WITHOUT WARRANTY // Auteur : JP CASSOU // OS : Windows NT - Linux // Langage : Free-Pascal 3.0.x sous Lazarus //----------------------------------------------------- // Eléments du cahier des charges: // - Les données sont stockées sous format texte // - Gestion de la base entièrement en mémoire sous forme d'une arborescence // - Les listes simples sont des TList dont les membres sont des 'record'. // - Les séries sont des objets autonomes stockés dans une liste de type TList // L'accès aux membres de l'objet se fait uniquement par getters et setters // - La création de nouveaux items se fait par des fonctions // de la forme AddObjet(const MonObjet) // - Le processus d'édition d'un objet est le suivant: // 1. Extraction d'un objet (expé, code, entrée, série, antenne, réseau) depuis sa liste // via une fonction de la forme GetObjet(const Idx: integer): TMonObjet // 2. Utilisation de l'objet et modification de ses propriétés // 3. Mise à jour de l'objet dans sa liste // via une fonction de la forme PutObjet(const Idx: integer; const Obj: TMonObjet); // - Support du format Toporobot TAB en lecture-écriture // - Support du format XTB ( = format TAB avec sections additionnelles) // - Lecture des fichiers Text (format considéré comme obsolète et peu robuste. // L'écriture dans ce format ne figure pas dans le CdC) // - Evolutivité vers un nouveau format de type XML // - Exportation vers d'autres logiciels // * Visual Topo (indispensable) - La méthode TOPOROBOT est incompatible avec la notation alphanumérique // * Therion (en cours de validation) //----------------------------------------------------- // Module : ToporobotClasses: // : Structure des données d'un dossier Toporobot // Compatibilité intégrale avec le standard Toporobot 1994. // 22/08/2012 : Refonte du noyau de GHTopo (ToporobotClasses) // en séparant le SGBD et le code de calcul // 24/08/2012 : Opérationnel // 14/02/2013 : Réacculturation au code de GHTopo. Petites corrections // Préparation de fonctions de recherche plein texte dans les listes // 03/05/2013 : Réorganisation du fichier de paramètres de compilation // 13/06/2013 : Quelques modifications dont ExtractFileNameOnly // 14/06/2013 : Implantation du nouveau format GHTopo XML // 03/10/2013 : DONE: Implémentation du support des lasermètres-clinomètres type Stanley TLM330 // 04/10/2013 : Conversions UTF8 <> ANSI fixed // 23/10/2013 : Fonctions de recherche dans les tables // 24/10/2013 : Support des secteurs, utilisés au niveau visée // 25/10/2013 : Découplage des listes simples de l'unité ToporobotClasses - Vont dans UnitListesSimples.pas // 10/11/2013 : Export en CSV au niveau des tables - DONE: Squelette des fonctions OK + En-tête séries/ // 11/11/2013 : Check des données: Longueurs OK, Azimuts OK, Pentes: Clinomètres std et lasermètre TLM330: OK (95% des configurations). // 15/11/2013 : DONE: Ajout des secteurs dans le format XML // **** CHANGEMENT DANS LE FORMAT XTB // 14/02/2014 : Ajout du support de la colonne 'Secteur' de la section AntennaShots // 30/06/2014 : Harmonisation avec la version Java. L'ajout de nouveaux éléments préparamétrés se fait ici. // 29/07/2014 : Stockage des composantes des couleurs dans le format XML pour éviter les complications de conversions // 20/11/2014 : Ajout de la fonction HasStationForAntennaShot() // 08/12/2014 : Export au format TOPOROBOT Text (pour PocketTopo) // 16/12/2014 : Fixation d'un bug dans LoadFileText (fonction deprecated) // 03/02/2015 : Suppression de stations et de leurs visées rayonnantes associées // 13/02/2015 : Fixation d'un bug dans les chargeurs de fichier (entrée 0 absente = doit être créée) // 31/03/2015 : Correction dans SaveToTab (section -9) // 12/05/2015 : Changement de numéro de série met à jour les visées rayonnantes // 13/05/2015 : Correction dans l'export VTopo // 18/05/2015 : corrections dans l'export/import Toporobot Text // 21/05/2015 : Nettoyage des antennes: Suppression des antennes accrochées à un point de la forme nnnn.0 // 29/05/2015 : Correction dans le chargement/sauvegrd XML: Pb de secteurs // 04/06/2015 : On passe aux génériques pour certaines listes ^^ // 16/07/2015 : Fonctions de correction d'erreur systématique des instruments: OK avec les Grottes du Roy // 22/02/2016 : Fonction FindPtTopoByCle(): Recherche par occurrence exacte ou texte contenant la clé // 24/04/2016 : Suppression de PutSerie(); inutile: un TObjSerie est un pointeur, toute modif validée dans un TObjSerie est répercutée dans la base. // 20/07/2016 : Les étiquettes de terrain et alias de stations topo sont gérés dans une table à part entière // 25/12/2016 : Tables FTableStylesAnnotations et FTableAnnotations pour les annotations // 04/08/2017 : Support des notes de version // 20/09/2018 : Section nouvelle: Filtres personnalisés // 26/11/2018 : Support des annotations supprimé: inutilisé en pratique; passe sous contrôle de TCroquisTerrain situé dans unitCroquisTerrain.pas // 29/01/2019 : Toutes les libérations d'objets se font par FreeAndNil(MonObjet) au lieu de MonObjet.Free // 31/01/2019 : Export vers la version 5.08 de Visual Topo // 15/02/2019 : Support des directives INCLUDE pour les listes simples et les visées en antenne // 01/01/2020 : Calcul des LRUD depuis les visées radiantes // 03/08/2020 : Point de contrôle temporel (contrôle de version) // 24/03/2021 : Import du format PocketTopo TXT // 24/03/2021 : Les fonctions d'ouverture et sauvegarde vont dans des fichiers FuncLoadSave*.inc // 29/03/2022 : Export VisualTopo TROX (XML) - VTopo historique désactivé // 25/05/2023 : Tables FTableStylesAnnotations et FTableAnnotations supprimées: désormais supportée par la fonctionnalité de croquis // 01/07/2024 : Support de SexyTopo // 02/07/2024 : Ajout du format alternatif JSON, au même niveau que le XTB et le GTX // 20/07/2024 : Export TOPOROBOT historique OK // 17/09/2024 : FindPtTopoByCle() fixé // 05/11/2024 : QAVE support dropped // 06/11/2024 : La table des séries est gérée par un TObjectList et non par un TList // 10/10/2025 : Petites corrections // //----------------------------------------------------- // Lecture // | Ajout // | | Modif // | | | Suppr // | | | | Count // | | | | | Tri // | | | | | | Recherche // Table entrées X X X X X 0 X // Table réseaux X X X X X 0 X // Table secteurs X X X X X 0 X // Table expés X X X X X X X // Table codes X X X X X X X // Table antennes X X X X X 0 0 // Table séries X X X X X X X // |-Stations X X X X X 0 0 // Table Antennes X X X X X 0 0 // // LoadFromTab() OK // LoadFichierText OK // SaveToFile() OK // LoadFromXML OK // SaveToXML OK // Export THERION OK /!\ A valider, tests OK à raison de la lecture par Loch // Export Visual Topo: OK /!\ Visual Topo est très peu tolérant. // Export Therion: Etat au 05/03/2014: // - Toporabot OK // - Charentais OK // - Saint Marcel OK // - Shuanghe OK // TODO: Gestion des projections géographiques // 10/06/2014: Correction dans le format XML (les éléments 0 ne sont pas exportés et sont reconstruits avant lecture) // 07/10/2016 : Mise en place d'un callback pour affichage de la progression (refonte de l'interface) // 13/10/2016 : Fixation d'un crash lié à l'absence de la série numéro 1. // Remède: La série est recréée automatiquement avec avertissement. // 27/07/2017 : Unification des getters et setters pour séries, codes, expés // les numéros de série, d'expé, de code, de réseau et de secteur deviennent des types scalaires (entiers) // 13/06/2019 : Point de contrôle temporel (contrôle de version) // 24/09/2019 : Dans les visées radiantes, les codes et expés héritent de ceux de la station d'accrochage. Ces champs sont supprimés dans TViseeAntenne // 09/10/2019 : Ajout de ExportListeAntennesCSV(): Export des visées en antenne au format CSV // 02/02/2025 : Beaucoup de getters externes sont remplacés par des propriétés en lecture seule, appelant éventuellement des getters internes interface uses {$INCLUDE SelectionLangues.inc} // insère les unités en fonction de la langue StructuresDonnees, GHTopoGeneralFunctions, unitDatesUtils, unitGHTopoViseesUtils, unitGHTopoStringUtils, unitColorsUtils, unitSolveEquationsPolynomes, Classes, SysUtils, Math, // anciennement Include Contnrs , unitTGHTopoStringArray , unitSearchResults , UnitListesSimplesWithGeneriques , UnitEntitesExtended // pour le check des longueurs , unitobjetserie , DateUtils , Graphics , LCLIntf, LCLType , UnitClasseMaillage , LazFileUtils , UnitTSAGeoMag // pour RecalculerDeclinaisonsMagnetiquesExpes() , Clipbrd , Laz2_DOM //DOM, , laz2_XMLWrite, laz2_XMLRead, UnitGHTopoXMLUtils // pour XML - Unités préfixées laz* à utiliser ( pas de XMLWrite !! ) , JsonTools , unitSexyTopo ; // REFONTE DU CONTENEUR TTOPOROBOTSTRUCTURE //------------------------------------------------------------------------------ type TModeSortSeries = (mssBY_NUMERO_SERIE, mssBY_NB_POINTS, mssBY_LONGUEUR); // ... a compléter type TSensTri = (stASC, stDESC); { TToporobotStructure2012 } type TToporobotStructure2012 = class private // Nombre max de résultats de recherche FNB_MAX_SEARCH_RESULTS : integer; // callback pour suivi de progression FProcDispProgression: TProcDisplayProgression; // général FDatabaseName : TStringDirectoryFilename; FNomEtude : string; // nom du complexe ; ex: Puts dets Tachous FCommentaireEtude : string; FSystemeDeCoordonneesCodeEPSG : TLabelSystemesCoordsEPSG; // coordonnées et station de référence FPositionPointZero : TPoint3Df; FRefSerie : TNumeroSerie; FRefPt : TNumeroStation; // listes simples FListeMessagesErreur : TListeMessagesErreur; FTableEntrances : TTableEntrances; //TODO: Ajouter un champ 'ID littéral' FTableSecteurs : TTableSecteurs; FTableReseaux : TTableReseaux; FTableExpes : TTableExpes; FTableCodes : TTableCodes; FTableViseesAntenne : TTableViseesAntenne; FTableFiltresPersonnalises: TTableFiltresPersonnalises; // filtres personnalisés FTablePointsOfInterest : TListePointsOfInterest; // Points d'intérêt // Backup des connexions des séries FBackupListeConnexionsOfSeries: TBackupListeConnexionsOfSeries; // liste des IDs terrain FTableIDsTerrain : TTableIDTerrain; // liste des séries FListeDesSeries : TObjectList; // dernier texte cherché FLastFindTextWhat : string; // dernières occurrences trouvées FLastFoundIdxEntrances : integer; FLastFoundIdxReseaux : integer; FLastFoundIdxSecteurs : integer; FLastFoundIdxExpes : integer; FLastFoundIdxCodes : integer; FLastFoundIdxSeries : integer; FLastFoundIdxPOIs : integer; FLastFoundIdxError : integer; // série et station courants FCurrentNumeroSerie : TNumeroSerie; FCurrentIndexStation : TNumeroStation; // pour mises en surbrillance // FCurrentNameSpace : integer; FCurrentNumeroEntrance : TNumeroEntrance; FCurrentNumeroExpe : TNumeroExpe; FCurrentNumeroCode : TNumeroCode; FCurrentNumeroReseau : TNumeroReseau; FCurrentNumeroSecteur : TNumeroSecteur; // contrôles, tris et définition des références function HasEntranceForStartingSerie(const S: TObjSerie): boolean; procedure Preconditionner(const QFilename: TStringDirectoryFilename); procedure SaveToSexyTopo_metadata_JSON(const FichierJSON: TStringDirectoryFilename); procedure SaveToSexyTopo_plan_ext_JSON(const FichierJSON: TStringDirectoryFilename); procedure SortSeries(const QModeSortSeries: TModeSortSeries; const Sens: TSensTri); function VerifieSerie1(): boolean; procedure AddMessageErreur(const M: TMessaqeErreurGHTopoCompiler); overload; procedure AddMessageErreur(const T: TTableExaminee; const QCriticite: TCriticiteMessaqeErreurGHTopo; const QIndex: Int64; const QMsg: string); overload; // SexyTopo procedure SaveToSexyTopo_data_JSON(const FichierJSON: TStringDirectoryFilename; const DoSplays: boolean); experimental; function GetNbEntrances(): integer; function GetNbReseaux(): integer; function GetNbSecteurs(): integer; function GetNbExpes(): integer; function GetNbCodes(): integer; function GetNbAntennes(): integer; function GetNbSeries(): integer; function GetNbLabelTerrain(): integer; function GetNbMessagesErreur(): integer; function GetNbPointsOfInterests(): integer; public property NB_MAX_SEARCH_RESULTS: integer read FNB_MAX_SEARCH_RESULTS; property CurrentNumeroEntrance : TNumeroEntrance read FCurrentNumeroEntrance; property CurrentNumeroCode : TNumeroCode read FCurrentNumeroCode; property CurrentNumeroExpe : TNumeroExpe read FCurrentNumeroExpe; property CurrentNumeroReseau : TNumeroReseau read FCurrentNumeroReseau; property CurrentNumeroSecteur : TNumeroSecteur read FCurrentNumeroSecteur; property CurrentNumeroSerie : TNumeroSerie read FCurrentNumeroSerie; property CurrentIndexPointOfSerie: integer read FCurrentIndexStation; property RefSerie: TNumeroSerie read FRefSerie; property RefPoint: TNumeroStation read FRefPt; property NomEtude: string read FNomEtude; property CommentairesEtude: string read FCommentaireEtude; property CodeEPSGSystemeCoordonnees: TLabelSystemesCoordsEPSG read FSystemeDeCoordonneesCodeEPSG; property PositionDuPointZero: TPoint3Df read FPositionPointZero; property NbEntrances: integer read GetNbEntrances; property NbReseaux: integer read GetNbReseaux; property NbSecteurs: integer read GetNbSecteurs; property NbCodes: integer read GetNbCodes; property NbExpes: integer read GetNbExpes; property NbSeries: integer read GetNbSeries; property NbAntennes: integer read GetNbAntennes; property NbLabelTerrain: integer read GetNbLabelTerrain; property NbMessagesErreur: integer read GetNbMessagesErreur; property NbPointsOfInterests: integer read GetNbPointsOfInterests; constructor Create; procedure ReInitialiser(const DoCreateItemsZero: boolean); procedure Finaliser(); function GetMessageErreur(const Idx: integer): TMessaqeErreurGHTopoCompiler; function GetNbTotalStations(): integer; procedure SetCurrentNumeroSerie(const S: TNumeroSerie); procedure SetCurrentIndexPointOfSerie(const S: integer); procedure SetCurrentIndexSeriePoint(const Ser: TNumeroSerie; const Pt: TNumeroStation); // gestion des espaces de noms (supprimé) procedure SetCurrentNumeroEntrance(const C: TNumeroEntrance); procedure SetCurrentNumeroCode(const C: TNumeroCode); procedure SetCurrentNumeroExpe(const C: TNumeroExpe); procedure SetCurrentNumeroReseau(const C: TNumeroReseau); procedure SetCurrentNumeroSecteur(const C: TNumeroSecteur); procedure SetProcDisplayProgression(const ProcProgression: TProcDisplayProgression); function GetProcDisplayProgression(): TProcDisplayProgression; procedure ViderTablesSimples(); procedure ViderListeViseesAntennes(); // s'agit-il d'un document GHTopo étendu ? function HasGHTopoCodesInstrumentsExtended(): boolean; function LoadFromXML(const FichierXML: TStringDirectoryFilename): integer; function SaveToXML(const FichierXML: TStringDirectoryFilename): integer; function LoadFromXTB(const FichierTAB: TStringDirectoryFilename): integer; procedure SaveToXTB(const FichierTAB: TStringDirectoryFilename; const ModeSaveTAB: TModeSaveTAB; const TextFileFormat: TTextFileFormat); function LoadFromJSON(const FichierJSON: TStringDirectoryFilename): integer; procedure SaveToJSON(const FichierJSON: TStringDirectoryFilename); // PocketTopo TXT et Toporobot Text function LoadFichierText(const FichierText: TStringDirectoryFilename): integer; deprecated 'Pour LimeLight et PocketTopo'; procedure ExporterVersToporobotTEXT(const QFileName: TStringDirectoryFilename; const LongueurMaxAntenne: double; const DoExportAntennaShots: boolean); deprecated 'Pour LimeLight et Pocket Topo'; function LoadFromPocketTopoTXT(const FichierTXT: TStringDirectoryFilename): integer; // Sexy Topo procedure CreateSexyTopoFolder(const QSexyTopoDirectory: TStringDirectoryFilename; const SurveyRootName: string); function LoadFromSexyTopoJSON(const FichierJSON: TStringDirectoryFilename): integer; experimental; //function LoadFromSexyTopoTXT(const FichierTXT: TStringDirectoryFilename): integer; experimental; // Qave // Therion procedure ExportVersSurvexOrTherion(const FichierTH: TStringDirectoryFilename; const SvxMode: TSvxMode); procedure GenererThConfig(const THConfig, QFichierTH, QFichierXVI: TStringDirectoryFilename; const QScale: integer; const QGridSize: double); procedure GenererDossierTherion(const DossierTherion: TStringDirectoryFilename; const QScale: integer; const QGridSize: double); // export de listes en CSV procedure ExportListeEntreesCSV(const ToClipBoard: boolean; const FileName: TStringDirectoryFilename); procedure ExportListeReseauxCSV(const ToClipBoard: boolean; const FileName: TStringDirectoryFilename); procedure ExportListeSecteursCSV(const ToClipBoard: boolean; const FileName: TStringDirectoryFilename); procedure ExportListeCodesCSV(const ToClipBoard: boolean; const FileName: TStringDirectoryFilename); procedure ExportListeExpesCSV(const ToClipBoard: boolean; const FileName: TStringDirectoryFilename); procedure ExportListeEntetesSeries(const ToClipBoard: boolean; const FileName: TStringDirectoryFilename); procedure ExportListePOIToCSV(const ToClipBoard: boolean; const FileName: TStringDirectoryFilename); procedure ExportListeErreursToCSV(const ToClipBoard: boolean; const FileName: TStringDirectoryFilename); procedure ExportSeriesCSV(const QFileName: TStringDirectoryFilename); procedure ExportListeAntennesCSV(const FileName: TStringDirectoryFilename); // recalcul des déclinaisons magnétiques procedure RecalculerDeclinaisonsMagnetiquesExpes(); // section General procedure SetNomEtude(const S: string); function GetNomEtude(): string; // pour PascalScript function GetCodeEPSGSystemeCoordonnees(): integer; procedure SetCommentairesEtude(const S: string); procedure SetDatabaseName(const S: string); procedure SetRefSeriePoint(const Ser: TNumeroSerie; const Pt: TNumeroStation); // systèmes de coordonnées procedure SetCodeEPSGSystemeCoordonnees(const CodeEPSG: TLabelSystemesCoordsEPSG); overload; procedure SetCodeEPSGSystemeCoordonnees(const qCodeEPSG: integer; const qNomEPSG: string); overload; // gestion des entrées procedure AddEntrance(constref AEntrance: TEntrance); function GetEntrance(const Idx: Integer): TEntrance; procedure PutEntrance(const NoEntrance: TNumeroEntrance; constref AEntrance: TEntrance); function RemoveEntrance(const Idx: integer): boolean; inline; function CreateNewEntrance(): boolean; function GetLastEntrance(): TEntrance; function CalcCentroideEntrees(): TPoint3Df; // gestion des réseaux procedure AddReseau(constref AReseau: TReseau); // Do not inline function GetReseau(const NumReseau: integer): TReseau; procedure PutReseau(const NoReseau: integer; constref AReseau: TReseau); // Do not inline function RemoveReseau(const Idx: integer): boolean; // Do not inline function CreateNouveauReseau(): boolean; function GetLastReseau(): TReseau; function HasNumeroReseau(const Idx: integer): boolean; function GetSeriesOfReseau(const NumReseau: integer; out A: TArrayOfIntegers): boolean; // gestion des secteurs procedure AddSecteur(constref ASecteur: TSecteur); // Do not inline function GetSecteur(const NumSecteur: integer): TSecteur; procedure PutSecteur(const NoSecteur: integer; constref ASecteur: TSecteur); // Do not inline function RemoveSecteur(const Idx: integer): boolean; inline; function CreateNouveauSecteur() : boolean; function GetLastSecteur(): TSecteur; function HasNumeroSecteur(const Idx: integer): boolean; // gestion des expés function MakeExpe0(const N: TNumeroExpe; const C: string): TExpe; procedure AddExpe(constref LaExpe: TExpe); // Do not inline function GetExpe(const Idx: integer): TExpe; // Do not inline procedure PutExpe(const Idx: integer; constref LaExpe: TExpe); // Do not inline function RemoveExpe(const Idx: integer): boolean; // Do not inline function GetExpeByNumero(const NumeroExpe: TNumeroExpe): TExpe; // Do not inline function CreateNouveauExpe() : boolean; function GetLastExpe(): TExpe; // gestion des codes function MakeCode0(const N: TNumeroExpe; const C: string): TCode; procedure AddCode(constref LeCode: TCode); // Do not inline function RemoveCode(const Idx: integer): boolean; // Do not inline procedure PutCode(const Idx: integer; constref LeCode: TCode); // Do not inline function GetCode(const Idx: integer): TCode; // Do not inline function GetCodeByNumero(const NumeroCode: TNumeroCode): TCode; // Do not inline function CreateNouveauCode(): boolean; function GetLastCode(): TCode; // gestion des antennes procedure AddViseeAntenne(constref VA: TViseeAntenne); function GetViseeAntenne(const No: integer): TViseeAntenne; procedure PutViseeAntenne(const No: integer; const VA: TViseeAntenne); function RemoveViseeAntenne(const No: integer): boolean; function RemoveLastViseeAntenne(): boolean; function NettoyerAntennes(const longMax: double; const qIdxSerie, qIdxStation: integer): integer; function ExtractSplaysOfStation(const NoSerie: TNumeroSerie; const NoStation: Integer; out ArrAntennesFound: TArrayOfTViseeAntenne): integer; // vérifier si la visée en antenne possède une station de rattachement // utilise l'IDTerrain, la série et le point // /!\ Modifie la visée passée en paramètre function HasStationForAntennaShot(var VA: TViseeAntenne): boolean; // gestion des séries procedure ClearListeSeries(); procedure BackupConnexionsSeries(); function CheckConnexionsSeries(const DoRepair: boolean): boolean; function CreateNewSerie(const SD, PD: integer; const QNumSerie: TNumeroSerie; const QNomSerie: string): boolean; procedure AddSerie(const S: TObjSerie); function GetSerie(const Idx: integer): TObjSerie; // /!\ Retourne un POINTEUR sur un objet TObjSerie function GetLastSerie(): TObjSerie; function GetSerieByNumeroSerie(const Idx: TNumeroSerie; out SR: TObjSerie; out InternalIdxSerie: integer): boolean; function FindIndexesSeriesRattachedAtSerie(const Idx: integer; out LS: TListOfIntegers): boolean; function RemoveSerie(const Idx: integer): boolean; function RechercherSeriesLibres(): TArrayOfIntegers; // prochains index valides function getMaxIdxCode(): TNumeroCode; function getMaxIdxExpe(): TNumeroExpe; function getMaxIdxSerie() : TNumeroSerie; function getMaxIdxSecteur(): integer; function getMaxIdxReseau(): integer; // recherche function FindIdxEntranceByText(const S: string): integer; function FindIdxReseauByText(const S: string): integer; function FindIdxSecteurByText(const S: string): integer; function FindIdxCodeByText(const S: string): integer; function FindIdxExpeByText(const S: string): integer; function FindIdxSerieByText(const S: string): integer; function FindIdxPOIsByText(const S: string): integer; function FindIdxErrorsByText(const S: string): integer; function FindIdxEntranceBySerSt(const S: TNumeroSerie; const P: TNumeroStation): integer; function SearchTextInTableSeriesStations(const QFindWhat: string; out SearchResults: TArrayStationsMatchFound): boolean; // procédures de tri procedure SortEntrances(const SensStri: TSensTri = stASC); procedure SortExpes(const SensStri: TSensTri = stASC); procedure SortCodes(const SensStri: TSensTri = stASC); procedure SortSeriesByNumSerie(const SensStri: TSensTri = stASC); procedure SortSeriesByNbPoints(const SensStri: TSensTri = stASC); procedure SortSeriesByLongueur(const SensStri: TSensTri = stASC); function SortAntennesByLengths(): integer; function SortAntennesBySerieStation(): integer; // nom de l'étude function GetDatabaseName: TStringDirectoryFilename; // coordonnées par défaut procedure SetDefaultCoords(const QX, QY, QZ: double); overload; procedure SetDefaultCoords(const QX, QY, QZ: string); overload; procedure SetDefaultCoords(constref P0: TPoint3Df); overload; // fonctions de recherche function FindPtTopoByCle(const DoMatchExact: boolean; var Cle: string; out Sr: TNumeroSerie; out Pt: integer): boolean; function FindPtsTopoByCle(const DoMatchExact: boolean; const Cle: string; out LS: TListeOfBipointsBaseStation): integer; function FindPtsTopoByLastStationsOfSeries(out LS: TListeOfBipointsBaseStation): integer; function HasPtTopoBySerSt(const qSr: TNumeroSerie; const qPt: TNumeroStation): boolean; // la série courante est connectée au réseau ( = n'est pas un cul de sac) function SerieConnectedAtOther(const qCurrNumSr: TNumeroSerie; out QSR: TNumeroSerie; out QPT: TNumeroStation): boolean; // aller à un index d'enregistrement depuis son numéro (pouvant être différent de l'index) function GetIdxEntreeByNumero(const N: TNumeroEntrance): integer; // Do not inline // simple wrapper function GetIdxReseauByNumero(const N: TNumeroReseau): integer; // Do not inline // simple wrapper function GetIdxSecteurByNumero(const N: TNumeroSecteur): integer; // Do not inline // simple wrapper function GetIdxCodeByNumero(const N: TNumeroCode): integer; function GetIdxExpeByNumero(const N: TNumeroExpe): integer; function GetIdxSerieByNumero(const qIdx: TNumeroSerie): integer; // infos générales sur les données de la cavité function GetInfosCavite(const LS: TStrings): integer; // test d'existence des éléments function ExistsIdxCode(const NumCode: TNumeroCode): boolean; // Do not inline function ExistsIdxExpe(const NumExpe: TNumeroExpe): boolean; // Do not inline function ExistsIdxSerie(const NumSerie: TNumeroSerie): boolean; // Do not inline // doublons ? function HasDoublonsInCodes(out ArrOfIdx: TArrayOfIntegers): boolean; // Do not inline function HasDoublonsInExpes(out ArrOfIdx: TArrayOfIntegers): boolean; // Do not inline function HasDoublonsInNumsSeries(out ArrOfIdx: TArrayOfIntegers): boolean; function NumSerieAlreadyAttributed(const NS: TNumeroSerie; out QInternalIdx: integer): boolean; function ExistsIdxReseau(const Idx: integer): boolean; // Do not inline function ExistsIdxEntrance(const Idx: integer): boolean; // Do not inline function GetLastFindText(): string; // Do not inline // check des données function CheckerLesDonneesTopo(const BDDEntites: TBDDEntites): Integer; procedure CheckerLesEntrees(); procedure CheckerLesSeries(const BDDEntites: TBDDEntites); procedure CheckerLesAntennes(); procedure CheckerLesCodes(); procedure CheckerLesExpes(); function CheckSerie(const MySerie: TObjSerie; const BDDEntites: TBDDEntites): integer; // retourne: -1 si série vide; numéro de visée si erreur, 0 si OK function CheckVisee(constref V: TUneVisee; out MsgErr: string): TSetErrorVisee; // Recherche de la première série invalide // (indispensable pour GHTopoLT: la majeure partie des 'spaghetti' après un recalcul provient d'une série vide) function HasInvalidSerie(out QIdx: integer; out QSerie: TObjSerie): boolean; // fix des erreurs function FixerViseesDeLongueurNulle: integer; function FixerEntrancesWithoutValidRef(): integer; function FixerLesAutoloops(): integer; function FixerExtremitesSeriesAt0and0: integer; // supprimme toutes les visées rayonnantes d'une station function RemoveViseesRayonnantesAssocieesAStation(const qSer, qSt: integer): integer; // renommer les points d'origine des visées rayonnantes associées à une station function MoveAntennesToAutreStation(const OldStation, NewStation: TToporobotIDStation; const DoDelete: boolean): integer; overload; function MoveAntennesToAutreStation(const OldSerie: TNumeroSerie; const OldPoint: integer; const NewSerie: TNumeroSerie; const NewPoint: integer; const DoDelete: boolean): integer; overload; function ReAttribuerViseesRayonnantesDeUneSerie(const SerieCourante: TObjSerie; const OldNumSerie: integer): integer; function UpdateSerPtExtremsSeriesRattachees(const OldNumSerie,NewNumSerie: integer): integer; // gestion des IDs terrain procedure RecenserLesIDsTerrain(); // Recense les stations dotées d'un ID terrain compémentaire au numéro de série.station function FindIdxIDTerrainByText(const Str: string): integer; procedure AddLabelTerrain(const ALabelTerrain: TToporobotIDStation); function GetLabelTerrain(const NumLabelTerrain: integer): TToporobotIDStation; procedure PutLabelTerrain(const NoLabelTerrain: integer; const ALabelTerrain: TToporobotIDStation); function RemoveLabelTerrain(const Idx: integer): boolean; // réattribution des codes, réseaux et expés pour les visées en antennes function ReattribuerCodesExpesViseesAntennes(): boolean; // fonctions de remplacement d'index procedure ReplaceIndexSeriesInEntrances(const OldIndex, NewIndex: TNumeroSerie); procedure ReplaceIndexInStations(const OldIndex, NewIndex: integer; const ModeRemplacement: TModeRemplacementStations); //procedure ReplaceIndexInSplays(const OldIndex, NewIndex: integer; const ModeRemplacement: TModeRemplacementAntennes); // Inutilisé procedure ReplaceIdxCodes(const OldIndex, NewIndex: TNumeroCode); procedure ReplaceIdxExpes(const OldIndex, NewIndex: TNumeroExpe); procedure ReplaceIdxSeries(const OldIndex, NewIndex: TNumeroSerie); // simplifie les visées en antenne d'une station (typiquement lors des scans de parois) procedure SimplifyAntennesOfAllReseau(const Tolerance: double); procedure SimplifyAntennesOfStation(const QSerie: TNumeroSerie; const QPoint: integer; const Tolerance: double); procedure SimplifyAntennesOfSerie(const QSerie: TObjSerie; const Tolerance: double); function PurgerTableAntennes(): integer; inline; procedure ResetMarkersToDelete(); inline; // calcul des LRUDData d'une station depuis les visées radiantes // filtres personnalisés procedure AddFiltrePerso(const FiltrePerso: TFiltrePersonnalise); inline; function GetFiltrePerso(const NumFiltrePerso: integer): TFiltrePersonnalise; inline; procedure PutFiltrePerso(const NoFiltrePerso: integer; const AFiltrePerso: TFiltrePersonnalise); inline; function RemoveFiltrePerso(const Idx: integer): boolean; inline; function GetNbFiltresPersos(): integer; inline; function GetLastFiltrePerso(): TFiltrePersonnalise; procedure ViderListeFiltres(); // points d'intérêt (POI) procedure AddPointOfInterest(constref APOI: TGHTopoPointOfInterest); function GetPointOfInterest(const Idx: integer): TGHTopoPointOfInterest; procedure PutPointOfInterest(const Idx: integer; const APOI: TGHTopoPointOfInterest); function RemovePointOfInterest(const Idx: integer): boolean; procedure RecenserPointsOfInterest(); procedure CheckerAltimetrieEntrancesByMNT(const FM: TMaillage; const DoAdjustAtMNT: boolean; const DeltaZMax: double); function TryToAddViseeAtDatabase(constref StFrom, StTo: TToporobotIDStation; constref V: TUneVisee): boolean; // Recherche plein texte dans la base function SearchIntoDatabase(const FindWhat: string; out Qresults: TSearchResultsInTopoData; const P: TCallbackOnFound): boolean; // Calcul d'incertitude pour un point topo function CalculIncertitude(const QNumSerie: TNumeroSerie; const QNumPt: TNumeroStation; out edx, edy, edz: double): boolean; experimental; // Recalculer les LRUDData depuis les splays function CalcLRUD_AllStationsOfTheSerie(const MySerie: TObjSerie; const QDefL, QDefR, QDefU, QDefD: double): boolean; function CalcLRUD_AStationOfTheSerie(const MySerie: TObjSerie; const QNumeroStation: integer; const QDefL, QDefR, QDefU, QDefD: double): boolean; experimental; function CalcLRUD_AStationOfSerieByNumSerSt(const QNumeroSerie: TNumeroSerie; const QNumeroStation: integer; const QDefL, QDefR, QDefU, QDefD: double): boolean; function CalcLRUD_AllStations(const QDefL, QDefR, QDefU, QDefD: double; const QCallbackProgression: TProcDisplayProgression): boolean; end; //------------------------------------------------------------------ implementation uses DGCDummyUnit; // Anti-erreur 'Fin du conde source non trouvée' {$INCLUDE unitGHTopoGTXKeywords.inc} // Pour support du format GTX {$INCLUDE unitGHTopoJSONKeywords.inc} // Pour support du format json //{$INCLUDE SexyTopoJSONKeywords.inc} // Pour support du format SexyTopo // Routines internes non incorporées dans les objets function SortEntrancesCriteria(Item1, Item2: Pointer): Integer; var E1, E2: ^TEntrance; S1, S2: TIDBaseStation; begin E1:=Item1; E2:=Item2; S1 := MakeTIDBaseStation(E1.eRefSer, E1.eRefSt); S2 := MakeTIDBaseStation(E2.eRefSer, E2.eRefSt); if (S1 < S2) then Result := -1 else if (S1 = S2) then Result := 0 else Result := 1; end; function SortCodesCriteria(Item1, Item2: Pointer): Integer; var E1, E2: ^TCode; begin E1:=Item1; E2:=Item2; if (E1.IDCode < E2.IDCode) then Result := -1 else if (E1.IDCode = E2.IDCode) then Result := 0 else Result := 1; end; // Trier les expés par ordre croissant function SortExpesCriteria(Item1, Item2: Pointer): Integer; var E1, E2: ^TExpe; begin E1:=Item1; E2:=Item2; if (E1.IDExpe < E2.IDExpe) then Result := -1 else if (E1.IDExpe = E2.IDExpe) then Result := 0 else Result := 1; end; // Trier les séries par ordre croissant function SortSerieCriteria(Item1, Item2: Pointer): Integer; var E1, E2: ^TObjSerie; begin E1:=Item1; E2:=Item2; if (E1.NumeroDeSerie < E2.NumeroDeSerie) then Result := -1 else if (E1.NumeroDeSerie = E2.NumeroDeSerie) then Result := 0 else Result := 1; end; // Trier les antennes par ordre de longueur croissante function SortViseeAntenneCriteriaLength(Item1, Item2: Pointer): Integer; var E1, E2: ^TViseeAntenne; begin E1:=Item1; E2:=Item2; if (E1.Longueur < E2.Longueur) then Result := -1 else if (E1.Longueur = E2.Longueur) then Result := 0 else Result := 1; end; function SortViseeAntenneCriteriaSerSt(Item1, Item2: Pointer): Integer; var E1, E2: ^TViseeAntenne; QSerStE1, QSerStE2: Int64; begin E1:=Item1; E2:=Item2; QSerStE1 := NB_MAXI_SERIES_PAR_CAVITE * Integer(E1.SerieDepart) + E1.PtDepart; QSerStE2 := NB_MAXI_SERIES_PAR_CAVITE * Integer(E2.SerieDepart) + E2.PtDepart; if (QSerStE1 < QSerStE2) then Result := -1 else if (QSerStE1 = QSerStE2) then Result := 0 else Result := 1; end; // TToporobotStructure2012 constructor TToporobotStructure2012.Create;//(AOwner: TObject); begin inherited Create; FNB_MAX_SEARCH_RESULTS:= 1000; // current FCurrentNumeroEntrance:= 0; FCurrentNumeroSerie := 0; FCurrentIndexStation := 0; FCurrentNumeroExpe := 0; FCurrentNumeroCode := 0; FCurrentNumeroReseau := 0; FCurrentNumeroSecteur := 0; // point zéro FPositionPointZero.Empty(); //AfficherMsgClass(self, 'Create'); FListeDesSeries := TObjectList.Create(True); FListeDesSeries.Clear; // tables simples FListeMessagesErreur := TListeMessagesErreur.Create; FTableEntrances := TTableEntrances.Create; FTableReseaux := TTableReseaux.Create; FTableSecteurs := TTableSecteurs.Create; FTableExpes := TTableExpes.Create; FTableCodes := TTableCodes.Create; FTableViseesAntenne := TTableViseesAntenne.Create; FTableIDsTerrain := TTableIDTerrain.Create; FTableFiltresPersonnalises := TTableFiltresPersonnalises.Create; FTablePointsOfInterest := TListePointsOfInterest.Create; FBackupListeConnexionsOfSeries := TBackupListeConnexionsOfSeries.Create; //AfficherMessage('-- Tables created'); end; procedure TToporobotStructure2012.ReInitialiser(const DoCreateItemsZero: boolean); var UneEntree : TEntrance; UneSerie : TObjSerie; UnReseau : TReseau; UnSecteur : TSecteur; QVisee : TUneVisee; begin ClearListeSeries(); ViderTablesSimples(); // numéros d'items courants FCurrentNumeroSerie := 0; FCurrentNumeroExpe := 0; FCurrentNumeroCode := 0; FCurrentNumeroReseau := 0; FCurrentNumeroSecteur := 0; // dernières occurrences trouvées FLastFindTextWhat := ''; FLastFoundIdxEntrances := -1; FLastFoundIdxReseaux := -1; FLastFoundIdxSecteurs := -1; FLastFoundIdxExpes := -1; FLastFoundIdxCodes := -1; FLastFoundIdxSeries := -1; FLastFoundIdxPOIs := -1; FLastFoundIdxError := -1; // Général AfficherMsgClass(self, 'ReInitialiser(): '); SetNomEtude('SansNom'); SetCommentairesEtude(''); SetCodeEPSGSystemeCoordonnees(DEFAULT_SYSTEME_COORDONNEES_CODE_EPSG, DEFAULT_SYSTEME_COORDONNEES_NOM); SetDefaultCoords(0.00, 0.00, 0.00); // Coordonnées du point zéro = celles de l'entrée principale //AfficherMessageErreur('001'); if (DoCreateItemsZero) then begin // ViderTablesSimples() vide toutes les tables CreateNewEntrance(); // créer une nouvelle entrée if (self.GetNbEntrances() > 0) then begin // et on récupère cette entrée pour contrôle UneEntree := GetEntrance(0); SetDefaultCoords(UneEntree.ePosition.X, UneEntree.ePosition.Y, UneEntree.ePosition.Z); end; UnReseau.setFrom(COULEUR_DEFAULT_RESEAU, 0, rsMAIN_NETWORK, ''); AddReseau(UnReseau); // Réseau 0 UnSecteur.setFrom(clSilver, rsFIRST_SECTEUR); AddSecteur(UnSecteur); // Secteur 0 AddExpe(MakeExpe0(0, 'Expe0')); // Expé 0 AddCode(MakeCode0(0, 'Code0')); // Code 0 end; //AfficherMessageErreur('002'); // série 0 -- A toujours créer UneSerie := TObjSerie.Create; try UneSerie.ClearStations(); // Opération 1: Vider la liste des visées UneSerie.SetChanceObstacle(0,0); // Opération 2: Chances et obstacles UneSerie.SetSeriePtExtremites(0,0,1,0); // Opération 3: Extrémités de la série UneSerie.SetNumeroSerie(0); // Opération 4: Numéro de série UneSerie.SetNomObsSerie(rsMSG_SERIE_INITIALISATION, ''); // Opération 5: Nom et observations sur la série UneSerie.SetRaideur(1.00); // Opération 6: Raideur UneSerie.SetCouleur(clBlack); // Opération 7: Couleur uneserie.SetNumeroEntranceReseau(0, 0); // Opération 8: Entrée de rattachement // Opération 10: Traitement des visées QVisee.Empty('Point 1.0'); UneSerie.AddVisee(QVisee); AddSerie(UneSerie); except on e: exception do AfficherMessageErreur(' **-**--** ' + E.Message); end; end; procedure TToporobotStructure2012.ViderTablesSimples(); begin AfficherMsgClass(self, 'ViderTablesSimples()'); try FBackupListeConnexionsOfSeries.ClearListe(); FListeMessagesErreur.ClearListe(); FTableReseaux.ClearListe(); FTableSecteurs.ClearListe(); FTableCodes.ClearListe(); FTableEntrances.ClearListe(); FTableExpes.ClearListe(); FTableViseesAntenne.ClearListe(); FTableIDsTerrain.ClearListe(); FTableFiltresPersonnalises.ClearListe(); FTablePointsOfInterest.ClearListe(); except AfficherMessage('Echec purge des tables simples'); end; end; procedure TToporobotStructure2012.ViderListeViseesAntennes(); begin FTableViseesAntenne.ClearListe(); end; // A invoquer avant libération // SIGSEGV inexpliqué si implanté dans le destructeur procedure TToporobotStructure2012.Finaliser(); begin try ViderTablesSimples(); //AfficherMessage('Finaliser ViderTablesSimples()'); ClearListeSeries(); finally FreeandNil(FBackupListeConnexionsOfSeries); FreeAndNil(FListeDesSeries);//FListeDesSeries.Free; FreeAndNil(FListeMessagesErreur);//FListeMessagesErreur.Free; FreeAndNil(FTableEntrances);//FTableEntrees.Free; FreeAndNil(FTableReseaux);//FTableReseaux.Free; FreeAndNil(FTableSecteurs);//FTableSecteurs.Free; FreeAndNil(FTableExpes);//FTableExpes.Free; FreeAndNil(FTableCodes);//FTableCodes.Free; FreeAndNil(FTableViseesAntenne);//FTableViseesAntenne.Free; FreeAndNil(FTableIDsTerrain);//FTableIDsTerrain.Free; // Tables additionnelles non dispo sur Android FreeAndNil(FTableFiltresPersonnalises);//FTableFiltresPersonnalises.Free; FreeAndNil(FTablePointsOfInterest);//FTablePointsOfInterest.Free; end; end; procedure TToporobotStructure2012.SetDefaultCoords(const QX, QY, QZ: double); begin FPositionPointZero.setFrom(QX, QY, QZ); end; procedure TToporobotStructure2012.SetDefaultCoords(constref P0: TPoint3Df); begin FPositionPointZero := P0; end; procedure TToporobotStructure2012.SetDefaultCoords(const QX, QY, QZ: string); begin FPositionPointZero.X := ConvertirEnNombreReel(QX, 0.00); FPositionPointZero.Y := ConvertirEnNombreReel(QY, 0.00); FPositionPointZero.Z := ConvertirEnNombreReel(QZ, 0.00); end; procedure TToporobotStructure2012.SetRefSeriePoint(const Ser: TNumeroSerie; const Pt: TNumeroStation); begin FRefSerie := Ser; FRefPt := Pt; end; procedure TToporobotStructure2012.SetNomEtude(const S: string); begin FNomEtude := S; end; function TToporobotStructure2012.GetNomEtude(): string; begin Result := FNomEtude; end; function TToporobotStructure2012.GetCodeEPSGSystemeCoordonnees(): integer; begin result := FSystemeDeCoordonneesCodeEPSG.CodeEPSG; end; procedure TToporobotStructure2012.SetProcDisplayProgression(const ProcProgression: TProcDisplayProgression); begin FProcDispProgression := ProcProgression; end; function TToporobotStructure2012.GetProcDisplayProgression(): TProcDisplayProgression; begin Result := FProcDispProgression; end; procedure TToporobotStructure2012.SetCommentairesEtude(const S: string); begin FCommentaireEtude := S; end; // la station topo courante procedure TToporobotStructure2012.SetCurrentIndexPointOfSerie(const S: integer); var SR: TObjSerie; QInternalIdxSerie: integer; begin if (S = -1) then // -1 = on attrape la dernière station de la série courante begin GetSerieByNumeroSerie(FCurrentNumeroSerie, SR, QInternalIdxSerie); FCurrentIndexStation := SR.NbVisees - 1; end else begin FCurrentIndexStation := S; end; end; procedure TToporobotStructure2012.SetCurrentNumeroSerie(const S: TNumeroSerie); begin FCurrentNumeroSerie := S; end; procedure TToporobotStructure2012.SetCurrentIndexSeriePoint(const Ser: TNumeroSerie; const Pt: TNumeroStation); begin self.SetCurrentNumeroSerie(Ser); self.SetCurrentIndexPointOfSerie(Pt); end; procedure TToporobotStructure2012.SetCurrentNumeroCode(const C: TNumeroCode); begin FCurrentNumeroCode := C; end; procedure TToporobotStructure2012.SetCurrentNumeroExpe(const C: TNumeroExpe); begin FCurrentNumeroExpe := C; end; procedure TToporobotStructure2012.SetCurrentNumeroReseau(const C: TNumeroReseau); begin FCurrentNumeroReseau := C; end; procedure TToporobotStructure2012.SetCurrentNumeroSecteur(const C: TNumeroSecteur); begin FCurrentNumeroSecteur := C; end; procedure TToporobotStructure2012.SetCurrentNumeroEntrance(const C: TNumeroEntrance); begin FCurrentNumeroEntrance := C; end; procedure TToporobotStructure2012.SetDatabaseName(const S: string); begin FDatabaseName:=S; end; function TToporobotStructure2012.GetDatabaseName: TStringDirectoryFilename; begin Result := FDatabaseName; end; //************************** procedure TToporobotStructure2012.SetCodeEPSGSystemeCoordonnees(const CodeEPSG: TLabelSystemesCoordsEPSG); begin FSystemeDeCoordonneesCodeEPSG := CodeEPSG; end; procedure TToporobotStructure2012.SetCodeEPSGSystemeCoordonnees(const qCodeEPSG: integer; const qNomEPSG: string); begin FSystemeDeCoordonneesCodeEPSG.CodeEPSG := qCodeEPSG; FSystemeDeCoordonneesCodeEPSG.NomEPSG := qNomEPSG; end; procedure TToporobotStructure2012.ClearListeSeries(); var ii, Nb: Integer; OO: TObjSerie; begin Nb := GetNbSeries(); AfficherMsgClass(self, 'ClearListeSeries(): %d series',[Nb]); if (0 = Nb) then exit; for ii := 0 to Nb - 1 do begin try OO := TObjSerie(FListeDesSeries.Items[ii]); //GetSerie(ii); OO.ClearStations(); //OO.Free; except pass; end; end; FListeDesSeries.Clear; end; procedure TToporobotStructure2012.BackupConnexionsSeries(); var i: Integer; MySerie: TObjSerie; Nb: LongInt; S: TBackupConnexionOfSerie; begin AfficherMsgErrClass(self, 'BackupConnexionsSeries():'); FBackupListeConnexionsOfSeries.ClearListe(); for i := 0 to GetNbSeries() - 1 do begin MySerie := GetSerie(i); FBackupListeConnexionsOfSeries.AddFrom(MySerie.NumeroDeSerie, MySerie.NomSerie, MySerie.NoSerieDep, MySerie.NoPointDep, MySerie.NoSerieArr, MySerie.NoPointArr); end; // controle Nb := FBackupListeConnexionsOfSeries.GetNbElements(); AfficherMessageErreur('-- %d series', [Nb]); for i := 0 to Nb-1 do begin S := FBackupListeConnexionsOfSeries.GetElement(i); AfficherMessageErreur(' %d: %d - %d.%d to %d.%d - %s', [i, S.NumeroDeSerie, S.SerieDep, S.PtDep, S.SerieArr, S.PtArr, S.NomSerie]); end; AfficherMessageErreur(''); end; function TToporobotStructure2012.CheckConnexionsSeries(const DoRepair: boolean): boolean; var i, Nb: LongInt; MySerie: TObjSerie; S: TBackupConnexionOfSerie; EWE: Boolean; begin result := false; Nb := FBackupListeConnexionsOfSeries.GetNbElements(); AfficherMsgErrClass(self, 'CheckConnexionsSeries(): %d', [nb]); if (0 = Nb) then exit; Nb := FBackupListeConnexionsOfSeries.GetNbElements(); AfficherMessageErreur('-- %d series', [Nb]); for i := 0 to Nb-1 do begin S := FBackupListeConnexionsOfSeries.GetElement(i); MySerie := GetSerie(i); EWE := (S.SerieDep = MySerie.NoSerieDep) AND (S.PtDep = MySerie.NoPointDep) and (S.SerieArr = MySerie.NoSerieArr) and (S.PtArr = MySerie.NoPointArr); if (not EWE) then begin AfficherMessageErreur(' -- %d: %d - (%d.%d) != (%d.%d) to (%d.%d) != (%d.%d) - %s', [i, S.NumeroDeSerie, S.SerieDep, S.PtDep, MySerie.NoSerieDep, MySerie.NoPointDep, S.SerieArr, S.PtArr, MySerie.NoSerieArr, MySerie.NoPointArr, S.NomSerie]); if (DoRepair) then begin pass; end; end; end; AfficherMessageErreur(''); end; function TToporobotStructure2012.CreateNewSerie(const SD, PD: integer; const QNumSerie: TNumeroSerie; const QNomSerie: string): boolean; var nb, QIdx: Integer; SR: TObjSerie; NSR, QSR: TObjSerie; MyExpe: TExpe; begin Result := False; NSR := TObjSerie.Create; try NSR.ClearStations(); // Opération 1: Vider la liste des visées NSR.SetChanceObstacle(0, 0); // Opération 2: Chances et obstacles // Opération 4: Numéro de série nb := GetNbSeries(); SR := GetSerie(nb - 1); if (GetSerieByNumeroSerie(QNumSerie, QSR, QIdx)) then NSR.SetNumeroSerie(1 + getMaxIdxSerie()) else if (QNumSerie < 0) then NSR.SetNumeroSerie(1 + getMaxIdxSerie()) else NSR.SetNumeroSerie(QNumSerie); NSR.SetSeriePtExtremites(SD, PD, NSR.NumeroDeSerie, 0); // Opération 3: Extrémités de la série NSR.SetNomObsSerie(QNomSerie, ''); // Opération 5: Nom et observations sur la série NSR.SetRaideur(1.00); // Opération 6: Raideur NSR.SetCouleur(SR.Couleur); // Opération 7: Couleur NSR.SetNumeroEntrance(SR.NumeroEntrance); // Opération 8: Entrée de rattachement NSR.SetNumeroReseau(SR.NumeroReseau); // Opération 9: Réseau de rattachement // Opération 10: Traitement des visées MyExpe := GetExpeByNumero(1); NSR.AddVisee(0, 1, 1, tgDEFAULT, 0.001, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, '', '', MyExpe.DateExpe, 0.00, 0.00); self.AddSerie(NSR); result := True; except FreeAndNil(NSR); end; end; function TToporobotStructure2012.GetNbSeries(): integer; begin Result := FListeDesSeries.Count; end; procedure TToporobotStructure2012.AddSerie(const S: TObjSerie); var pS: ^TObjSerie; begin // Uniquement si TList est utilisé //New(pS); //pS^ := S; //FListeDesSeries.Add(pS); // FListeDesSeries.Add(S); end; // /!\ Retourne un POINTEUR sur un objet TObjSerie // i.e: Toutes les modifications apportées à l'objet retourné par cette fonction // sont validées // Rappel: En Pascal, un TObject EST un pointeur function TToporobotStructure2012.GetSerie(const Idx: integer): TObjSerie; begin Result := TObjSerie(FListeDesSeries.Items[Idx]); end; //*) function TToporobotStructure2012.GetSerieByNumeroSerie(const Idx: TNumeroSerie; out SR: TObjSerie; out InternalIdxSerie: integer): boolean; var i, Nb: Integer; begin Result := false; SR := nil; Nb := GetNbSeries; if (Nb = 0) then Exit; for i := 0 to Nb - 1 do begin SR := GetSerie(i); InternalIdxSerie := i; if (Idx = SR.NumeroDeSerie) then Exit(True); end; end; function TToporobotStructure2012.RemoveSerie(const Idx: integer): boolean; var MySerie: TObjSerie; begin Result := False; try try MySerie := self.GetSerie(Idx); MySerie.ClearStations(); // Uniquement si on utilise un TList // TObjectList détruit l'objet associé à l'item; //FreeAndNil(MySerie); //Dispose(FListeDesSeries.Items[Idx]); Result := True; except AfficherMsgErrClass(self, '%s.RemoveSerie(): Error in %d', [Idx]); end; finally FListeDesSeries.Delete(Idx); end; end; function TToporobotStructure2012.RechercherSeriesLibres(): TArrayOfIntegers; var i, Nb: Integer; NumSerieMax: TNumeroSerie; EWE: String; begin Nb := GetNbSeries(); NumSerieMax := getMaxIdxSerie(); EWE := format('RechercherSeriesLibres(): %d séries, Numero max: %d', [Nb, NumSerieMax]); AfficherMsgClass(self, EWE); AfficherMsgErrClass(self, EWE); Result.ReDim(0); for i := 1 to NumSerieMax-1 do begin if (GetIdxSerieByNumero(i) = -1) then begin AfficherMessageErreur('-- Série libre ajoutée: %d', [i]); Result.appendFrom(i); end; end; AfficherMessageErreur('Nombre de séries libres: %d', [result.getNbElements()]); end; function TToporobotStructure2012.GetLastSerie(): TObjSerie; begin Result := GetSerie(FListeDesSeries.Count - 1); end; // fonctions de recherche function TToporobotStructure2012.FindIdxEntranceByText(const S: string): integer; var i, N, P : integer; EWE: TEntrance; begin //AfficherMsgClass(self, 'FindIdxEntranceByText(): %s', [S]); Result := -1; N := GetNbEntrances() - 1; P := IIF((FLastFoundIdxEntrances = -1), 0, FLastFoundIdxEntrances); for i := P to N do begin EWE := GetEntrance(i); if (Pos(LowerCase(S), LowerCase(EWE.eNomEntree + ' ' + EWE.eObserv)) > 0) then begin FLastFindTextWhat := S; // mémorise la clé pour recherche de l'occurrence suivante FLastFoundIdxEntrances := i + 1; // mémorise l'indice de parcours if (FLastFoundIdxEntrances > N) then FLastFoundIdxEntrances := -1; // on boucle depuis le début de la liste Result := i; Exit; end; end; if (Result = -1) then FLastFoundIdxEntrances := -1; end; function TToporobotStructure2012.FindIdxReseauByText(const S: string): integer; var i, N, P : integer; EWE: TReseau; begin //AfficherMsgClass(self, 'FindIdxReseauByText(): %s', [S]); Result := -1; N := GetNbReseaux() - 1; P := IIF((FLastFoundIdxReseaux = -1), 0, FLastFoundIdxReseaux); for i := P to N do begin EWE := GetReseau(i); if (Pos(LowerCase(S), LowerCase(EWE.NomReseau + ' ' + EWE.ObsReseau)) > 0) then begin FLastFindTextWhat := S; // mémorise la clé pour recherche de l'occurrence suivante FLastFoundIdxReseaux := i + 1; // mémorise l'indice de parcours if (FLastFoundIdxReseaux > N) then FLastFoundIdxReseaux := -1; // on boucle depuis le début de la liste exit(i); end; end; if (Result = -1) then FLastFoundIdxReseaux := -1; end; function TToporobotStructure2012.FindIdxSecteurByText(const S: string): integer; var i, N, P : integer; EWE: TSecteur; begin AfficherMsgClass(self, 'FindIdxSecteurByText(): %s', [S]); Result := -1; N := GetNbSecteurs() - 1; P := IIF((FLastFoundIdxSecteurs = -1), 0, FLastFoundIdxSecteurs); for i := P to N do begin EWE := GetSecteur(i); if (Pos(LowerCase(S), LowerCase(EWE.NomSecteur)) > 0) then begin FLastFindTextWhat := S; // mémorise la clé pour recherche de l'occurrence suivante FLastFoundIdxSecteurs := i + 1; // mémorise l'indice de parcours if (FLastFoundIdxSecteurs > N) then FLastFoundIdxSecteurs := -1; // on boucle depuis le début de la liste exit(i); end; end; if (Result = -1) then FLastFoundIdxSecteurs := -1; end; function TToporobotStructure2012.FindIdxExpeByText(const S: string): integer; var i, N, P : integer; EWE : TExpe; zdar : String; begin AfficherMsgClass(self, 'FindIdxExpeByText(): %s', [S]); Result := -1; N := GetNbExpes() - 1; P := IIF((FLastFoundIdxExpes = -1), 0, FLastFoundIdxExpes); for i := P to N do begin EWE := GetExpe(i); zdar := Format('%d %s %s %s %s', [EWE.IDExpe, DatePascalToDateSQL(EWE.DateExpe), EWE.Operateur, EWE.ClubSpeleo, EWE.Commentaire]); if (Pos(LowerCase(S), LowerCase(zdar)) > 0) then begin FLastFindTextWhat := S; // mémorise la clé pour recherche de l'occurrence suivante FLastFoundIdxExpes := i + 1; // mémorise l'indice de parcours if (FLastFoundIdxExpes > N) then FLastFoundIdxExpes := -1; // on boucle depuis le début de la liste exit(i); end; end; if (Result = -1) then FLastFoundIdxExpes := -1; end; function TToporobotStructure2012.FindIdxCodeByText(const S: string): integer; var i, N, P : integer; EWE : TCode; zdar: String; begin AfficherMsgClass(self, 'FindIdxCodeByText(): %s', [S]); Result := -1; N := GetNbCodes() - 1; P := IIF((FLastFoundIdxCodes = -1), 0, FLastFoundIdxCodes); for i := P to N do begin EWE := GetCode(i); zdar := format('%d %s', [EWE.IDCode, EWE.Commentaire]); if (Pos(LowerCase(S), LowerCase(zdar)) > 0) then begin FLastFindTextWhat := S; // mémorise la clé pour recherche de l'occurrence suivante FLastFoundIdxCodes := i + 1; // mémorise l'indice de parcours if (FLastFoundIdxCodes > N) then FLastFoundIdxCodes := -1; // on boucle depuis le début de la liste exit(i); end; end; if (Result = -1) then FLastFoundIdxCodes := -1; end; function TToporobotStructure2012.FindIdxSerieByText(const S: string): integer; var EWE : TObjSerie; i, N, P: Integer; QIdx, IdxAChercher: integer; begin AfficherMsgClass(self, 'FindIdxSerieByText(): %s', [S]); Result := -1; // on fait une recherche sur le numéro de série QIdx := 0; IdxAChercher := StrToIntDef(trim(S), -1); if (GetSerieByNumeroSerie(IdxAChercher, EWE, QIdx)) then Exit(QIdx); N := GetNbSeries - 1; P := IIF((FLastFoundIdxSeries = -1), 0, FLastFoundIdxSeries); for i := P to N do begin EWE := GetSerie(i); if (Pos(LowerCase(S), LowerCase(EWE.NomSerie)) > 0) then begin FLastFindTextWhat := S; // mémorise la clé pour recherche de l'occurrence suivante FLastFoundIdxSeries := i + 1; // mémorise l'indice de parcours if (FLastFoundIdxSeries > N) then FLastFoundIdxSeries := -1; // on boucle depuis le début de la liste exit(i); end; end; if (Result = -1) then FLastFoundIdxSeries := -1; end; function TToporobotStructure2012.FindIdxPOIsByText(const S: string): integer; var N, P, i: Integer; EWE: TGHTopoPointOfInterest; zdar: String; begin AfficherMsgClass(self, 'FindIdxPOIsByText(): %s', [S]); Result := -1; if (GetNbPointsOfInterests() = 0) then exit; N := GetNbPointsOfInterests() - 1; P := IIF((FLastFoundIdxPOIs = -1), 0, FLastFoundIdxPOIs); for i := P to N do begin EWE := GetPointOfInterest(i); zdar := format('%d: %d.%d %s %s', [i, EWE.Serie, EWE.Station, EWE.LabelTerrain, EWE.Description]); if (Pos(LowerCase(S), LowerCase(zdar)) > 0) then begin FLastFindTextWhat := S; // mémorise la clé pour recherche de l'occurrence suivante FLastFoundIdxPOIs := i + 1; // mémorise l'indice de parcours if (FLastFoundIdxPOIs > N) then FLastFoundIdxPOIs := -1; // on boucle depuis le début de la liste exit(i); end; end; if (Result = -1) then FLastFoundIdxPOIs := -1; end; function TToporobotStructure2012.FindIdxErrorsByText(const S: string): integer; var EWE: TMessaqeErreurGHTopoCompiler; N, P, i: Integer; zdar: String; begin AfficherMsgClass(self, 'FindIdxErrorsByText(): %s', [S]); Result := -1; if (GetNbMessagesErreur() = 0) then exit; N := GetNbMessagesErreur() - 1; P := IIF((FLastFoundIdxError = -1), 0, FLastFoundIdxError); for i := P to N do begin EWE := GetMessageErreur(i); zdar := format('%d: %s', [i, EWE.Message]); if (Pos(LowerCase(S), LowerCase(zdar)) > 0) then begin FLastFindTextWhat := S; // mémorise la clé pour recherche de l'occurrence suivante FLastFoundIdxError := i + 1; // mémorise l'indice de parcours if (FLastFoundIdxError > N) then FLastFoundIdxError := -1; // on boucle depuis le début de la liste exit(i); end; end; if (Result = -1) then FLastFoundIdxError := -1; end; function TToporobotStructure2012.FindIdxEntranceBySerSt(const S: TNumeroSerie; const P: TNumeroStation): integer; var i, Nb: Integer; EWE: TEntrance; begin //AfficherMsgClass(self, 'FindIdxEntranceBySerSt(): "%d.%d"', [ S, P]); Result := -1; Nb := GetNbEntrances(); if (Nb = 0) then Exit; for i := 0 to Nb - 1 do begin EWE := GetEntrance(i); if ((S = EWE.eRefSer) AND (P = EWE.eRefSt)) then Exit(i); end; end; function TToporobotStructure2012.SearchTextInTableSeriesStations(const QFindWhat: string; out SearchResults: TArrayStationsMatchFound ): boolean; const FMT_MATCH_FOUND = '%d.%d: %s'; var StringToScan: string; QResultsCount, i, NbS, j: Integer; SR: TObjSerie; ST: TUneVisee; function HasTextIn(const QStringToScan: string): boolean; begin result := (pos(Lowercase(QFindWhat), lowercase(QStringToScan)) > 0); if (result) then begin Inc(QResultsCount); AfficherMessageErreur('HasTextToFindIn(%s in %s', [ QFindWhat, QStringToScan]); end; end; begin QResultsCount := 0; result := false; SearchResults.Redim(0); AfficherMsgErrClass(self, 'SearchTextInTableSeriesStations(): %s', [ QFindWhat]); AfficherMessageErreur('========== Search results ==========='); NbS := GetNbSeries(); for i := 0 to NbS - 1 do begin SR := GetSerie(i); StringToScan := SR.StationDepart.ToString() + SR.StationArrivee.ToString() + SR.NomSerie + SR.ObsSerie; StringToScan := LowerCase(StringToScan); if (HasTextIn(StringToScan)) then begin SearchResults.appendFrom(SR.NumeroDeSerie, 1, SR.NomSerie + ' ' + SR.ObsSerie); AfficherMessageErreur(FMT_MATCH_FOUND, [SR.NumeroDeSerie, 0, SR.NomSerie]); end; for j := 1 to SR.NbVisees - 1 do begin ST := SR.GetVisee(j); StringToScan := lowerCase(ST.IDTerrainStation + ST.Commentaires); if (HasTextIn(StringToScan)) then begin SearchResults.appendFrom(SR.NumeroDeSerie, j, Trim(ST.IDTerrainStation + ' ' + ST.Commentaires)); AfficherMessageErreur(FMT_MATCH_FOUND, [SR.NumeroDeSerie, j, ST.IDTerrainStation + ST.Commentaires]); end; end; end; AfficherMessageErreur('====================================='); AfficherMessageErreur('%d matches found', [QResultsCount]); result := (QResultsCount > 0); end; procedure TToporobotStructure2012.SortEntrances(const SensStri: TSensTri); begin FTableEntrances.Sort(SortEntrancesCriteria); end; // fonctions de tri procedure TToporobotStructure2012.SortExpes(const SensStri: TSensTri); begin FTableExpes.Sort(SortExpesCriteria); end; procedure TToporobotStructure2012.SortCodes(const SensStri: TSensTri); begin FTableCodes.Sort(SortCodesCriteria); end; // Ne pas utiliser ici le Sort intégré dans le TList de la série // TList.Sort travaille sur toute la liste, or il faut trier ici entre 1 et n-1b uniquement. procedure TToporobotStructure2012.SortSeries(const QModeSortSeries: TModeSortSeries; const Sens: TSensTri); procedure QSortSeries(lidx, ridx: integer); var k, e: integer; QSer1, QSer2: TObjSerie; V1, V2: Int64; B: Boolean; procedure QSetV1V2(const S1, S2: TObjSerie); begin case QModeSortSeries of mssBY_NUMERO_SERIE: begin V1 := QSer1.NumeroDeSerie ; V2 := QSer2.NumeroDeSerie ; end; mssBY_NB_POINTS : begin V1 := QSer1.NbVisees ; V2 := QSer2.NbVisees ; end; mssBY_LONGUEUR : begin V1 := trunc(1000 * QSer1.GetLongueurOfSerie()); V2 := trunc(1000 * QSer2.GetLongueurOfSerie()); end else pass; end; end; begin if (lidx >= ridx) then Exit; //mid := (lidx + ridx) div 2; FListeDesSeries.Exchange(lidx, ridx); e:=lidx; for k:=lidx+1 to ridx do begin QSer1 := GetSerie(k); QSer2 := GetSerie(lidx); QSetV1V2(QSer1, QSer2); case Sens of stASC : B := (V1 < V2); stDESC: B := (V1 > V2); end; if (B) then begin Inc(e); FListeDesSeries.Exchange(e, k); end; end; FListeDesSeries.Exchange(lidx, e); QSortSeries(lidx, e-1); QSortSeries(e+1, ridx); end; begin AfficherMsgClass(self, 'SortSeries(): Tri des series par numéro de série'); QSortSeries(1, GetNbSeries() - 1); end; procedure TToporobotStructure2012.SortSeriesByNumSerie(const SensStri: TSensTri = stASC); begin SortSeries(TModeSortSeries.mssBY_NUMERO_SERIE, SensStri); end; procedure TToporobotStructure2012.SortSeriesByNbPoints(const SensStri: TSensTri = stASC); begin AfficherMsgClass(self, 'SortSeries(): Tri des series par nb de points'); SortSeries(TModeSortSeries.mssBY_NB_POINTS, SensStri); end; procedure TToporobotStructure2012.SortSeriesByLongueur(const SensStri: TSensTri = stASC); begin AfficherMsgClass(self, 'SortSeries(): Tri des series par longueur'); SortSeries(TModeSortSeries.mssBY_LONGUEUR, SensStri); end; function TToporobotStructure2012.SortAntennesByLengths(): integer; begin Result := -1; try FTableViseesAntenne.Sort(SortViseeAntenneCriteriaLength); result := FTableViseesAntenne.GetNbElements(); except end; end; function TToporobotStructure2012.SortAntennesBySerieStation(): integer; begin Result := -1; try FTableViseesAntenne.Sort(SortViseeAntenneCriteriaSerSt); result := FTableViseesAntenne.GetNbElements(); except end; end; function TToporobotStructure2012.VerifieSerie1(): boolean; var QSR, MySerie: TObjSerie; QIdx: integer; begin result := false; AfficherMsgClass(self, 'VerifieSerie1()'); //AfficherMessageErreur('Entre dans %s.VerifieSerie1: %d séries', [ClassName, GetNbSeries()]); if (GetSerieByNumeroSerie(1, QSR, QIdx)) then begin AfficherMessageErreur('*** Série 1 correcte ***'); Exit(True); end; // si la série 1 est inexistante, on la crée // en supprimant la série bâtarde 1 try self.RemoveSerie(1); except AfficherMessageErreur('*** Série 1 supprimée mais non libérée ***'); end; AfficherMessageErreur('-> Série 1 inexistante. Recréée'); MySerie := TObjSerie.Create; MySerie.ClearStations(); MySerie.SetNumeroSerie(1); MySerie.AddVisee( 0, 0, 0, tgDEFAULT , 0.0100, 45.00, -45.00, 0.0, 0.0, 0.0, 0.0, '', '', Now(), 0.00, 0.00); MySerie.AddVisee( 0, 0, 0, tgDEFAULT , 0.0125, 45.00, -45.00, 0.0, 0.0, 0.0, 0.0, '', '', Now(), 0.00, 0.00); MySerie.SetSeriePtExtremites(MySerie.NumeroDeSerie, 0, MySerie.NumeroDeSerie, MySerie.NbVisees - 1); MySerie.SetChanceObstacle(0, 0); MySerie.SetNomObsSerie('Serie 1 reconstruite', 'Serie 1 absente dans le fichier original - Recréée'); self.AddSerie(MySerie); self.SortSeriesByNumSerie(); // et on trie la table result := True; end; // contrôles, tris et définition des références procedure TToporobotStructure2012.Preconditionner(const QFilename: TStringDirectoryFilename); var UneEntree: TEntrance; begin self.SetDatabaseName(ExtractFileNameWithoutExt(QFilename)); VerifieSerie1(); // Cause courante de plantages: Absence de la série 1 CheckerLesDonneesTopo(nil); RecenserLesIDsTerrain(); RecenserPointsOfInterest(); SortCodes(); SortExpes(); //SortSeries(); TODO Trier les séries ? UneEntree := GetEntrance(0); self.SetRefSeriePoint(UneEntree.eRefSer, UneEntree.eRefSt); self.SetDefaultCoords(UneEntree.ePosition.X, UneEntree.ePosition.Y, UneEntree.ePosition.Z); end; //****************************************************************************** {$INCLUDE FuncLoadSaveFichierJSON.inc} //****************************************************************************** //* Méthodes relatives aux entrées procedure TToporobotStructure2012.AddEntrance(constref AEntrance: TEntrance); var Nb: Integer; begin FTableEntrances.AddElement(AEntrance); end; function TToporobotStructure2012.GetEntrance(const Idx: Integer): TEntrance; begin try Result := FTableEntrances.GetElement(Idx); except Result := FTableEntrances.GetElement(0); end; end; procedure TToporobotStructure2012.PutEntrance(const NoEntrance: TNumeroEntrance; constref AEntrance: TEntrance); begin FTableEntrances.PutElement(NoEntrance, AEntrance); end; function TToporobotStructure2012.RemoveEntrance(const Idx: integer): boolean; begin Result := FTableEntrances.RemoveElement(Idx); end; function TToporobotStructure2012.GetNbEntrances(): integer; begin Result := FTableEntrances.GetNbElements(); end; function TToporobotStructure2012.CreateNewEntrance(): boolean; var nb: Integer; EWE: TEntrance; begin result := false; EWE.setFrom('Entrée principale', '1.0', self.PositionDuPointZero, 1, 0, clRed, '', True, tteGROTTE); try Nb := GetNbEntrances(); if (Nb > 0) then begin EWE := GetEntrance(nb - 1); EWE.eCouleur := clYellow; EWE.eNomEntree := 'Nouvelle entrée'; self.AddEntrance(EWE); end ; result := true; except end; end; // méthodes relatives aux réseaux procedure TToporobotStructure2012.AddReseau(constref AReseau: TReseau); begin FTableReseaux.AddElement(AReseau); end; function TToporobotStructure2012.GetReseau(const NumReseau: integer): TReseau; begin try Result := FTableReseaux.GetElement(NumReseau); except Result := FTableReseaux.GetElement(0); end; end; procedure TToporobotStructure2012.PutReseau(const NoReseau: integer; constref AReseau: TReseau); begin FTableReseaux.PutElement(NoReseau, AReseau); end; function TToporobotStructure2012.RemoveReseau(const Idx: integer): boolean; begin Result := FTableReseaux.RemoveElement(Idx); end; function TToporobotStructure2012.GetNbReseaux(): integer; begin Result := FTableReseaux.GetNbElements(); end; // méthodes relatives aux labels de terrain procedure TToporobotStructure2012.AddLabelTerrain(const ALabelTerrain: TToporobotIDStation); begin FTableIDsTerrain.AddElement(ALabelTerrain); end; function TToporobotStructure2012.GetLabelTerrain(const NumLabelTerrain: integer): TToporobotIDStation; begin Result := FTableIDsTerrain.GetElement(NumLabelTerrain); end; procedure TToporobotStructure2012.PutLabelTerrain(const NoLabelTerrain: integer; const ALabelTerrain: TToporobotIDStation); begin FTableIDsTerrain.PutElement(NoLabelTerrain, ALabelTerrain); end; function TToporobotStructure2012.RemoveLabelTerrain(const Idx: integer): boolean; begin Result := FTableIDsTerrain.RemoveElement(Idx); end; function TToporobotStructure2012.GetNbLabelTerrain: integer; begin Result := FTableIDsTerrain.GetNbElements; end; function TToporobotStructure2012.CreateNouveauReseau(): boolean; var nb: Integer; EWE: TReseau; begin Result := false; try nb := GetNbReseaux; EWE := GetReseau(nb - 1); EWE.NomReseau := 'Nouveau reseau'; EWE.ObsReseau := ''; self.AddReseau(EWE); result := true; except pass; end; end; function TToporobotStructure2012.GetLastReseau(): TReseau; var Nb: Integer; begin Nb := self.GetNbReseaux - 1; Result := GetReseau(Nb); end; function TToporobotStructure2012.GetLastEntrance(): TEntrance; var Nb: Integer; begin Nb := self.GetNbEntrances() - 1; Result := GetEntrance(Nb); end; function TToporobotStructure2012.CalcCentroideEntrees(): TPoint3Df; var NbEntrances, Nb, i: Integer; MyEntrance: TEntrance; QX0, QY0, QZ0: double; begin NbEntrances := GetNbEntrances(); MyEntrance := GetEntrance(0); Result := MyEntrance.ePosition; Nb := 0; QX0 := 0.00; QY0 := 0.00; QZ0 := 0.00; for i := 0 to NbEntrances - 1 do begin try MyEntrance := GetEntrance(i); if (IsZero(MyEntrance.ePosition.X) or IsZero(MyEntrance.ePosition.Y)) then Continue; QX0 := QX0 + MyEntrance.ePosition.X; QY0 := QY0 + MyEntrance.ePosition.Y; QZ0 := QZ0 + MyEntrance.ePosition.Z; Nb := Nb + 1; except end; end; if (Nb <> 0) then Result.setFrom(QX0 / Nb, QY0 / Nb, QZ0 / Nb); end; function TToporobotStructure2012.HasNumeroReseau(const Idx: integer): boolean; var n: Integer; begin n := GetNbReseaux(); Result := (Idx < n); end; function TToporobotStructure2012.GetSeriesOfReseau(const NumReseau: integer; out A: TArrayOfIntegers): boolean; var LS: TStringList; SR: TObjSerie; i, Nb: Integer; begin result := false; AfficherMsgClass(self, 'GetSeriesOfReseau(): %d', [NumReseau]); LS := TStringList.Create; try LS.Clear; LS.Sorted := true; LS.Duplicates := dupIgnore; for i := 1 to GetNbSeries() - 1 do begin SR := GetSerie(i); if (NumReseau = SR.NumeroReseau) then LS.Add(format('%d', [SR.NumeroDeSerie])); end; Nb := LS.Count; if (0 = Nb) then exit(false); A.Redim(Nb); for i := 0 to LS.Count - 1 do A.setFrom(i, StrToIntDef(LS.Strings[i], 0)); result := (Nb > 0); finally freeandNil(LS); end; end; // Méthodes relatives aux secteurs procedure TToporobotStructure2012.AddSecteur(constref ASecteur: TSecteur); begin FTableSecteurs.AddElement(ASecteur); end; function TToporobotStructure2012.GetSecteur(const NumSecteur: integer): TSecteur; begin try Result := FTableSecteurs.GetElement(NumSecteur); except Result := FTableSecteurs.GetElement(0); end; end; procedure TToporobotStructure2012.PutSecteur(const NoSecteur: integer; constref ASecteur: TSecteur); begin FTableSecteurs.PutElement(NoSecteur, ASecteur); end; function TToporobotStructure2012.RemoveSecteur(const Idx: integer): boolean; begin result := FTableSecteurs.RemoveElement(Idx); end; function TToporobotStructure2012.GetNbSecteurs(): integer; begin Result := FTableSecteurs.GetNbElements; end; function TToporobotStructure2012.CreateNouveauSecteur(): boolean; var nb: Integer; EWE: TSecteur; begin result := false; try nb := GetNbSecteurs(); EWE := GetSecteur(nb - 1); EWE.NomSecteur := 'Nouveau secteur'; self.AddSecteur(EWE); result := true; except end; end; function TToporobotStructure2012.GetLastSecteur(): TSecteur; var Nb: Integer; begin Nb := self.GetNbSecteurs - 1; Result := GetSecteur(Nb); end; function TToporobotStructure2012.HasNumeroSecteur(const Idx: integer): boolean; var n: Integer; begin n := GetNbSecteurs(); Result := (Idx < n); end; function TToporobotStructure2012.MakeExpe0(const N: TNumeroExpe; const C: string): TExpe; begin Result.IDExpe := N; Result.DateExpe := Now(); Result.Operateur := DFT_OPERATEUR; // spéléomètre Result.ClubSpeleo := DFT_CLUB_SPELEO; // spéléographe Result.ModeDecl := cdmAUTOMATIQUE; // déclinaison auto ? Result.DeclinaisonInDegrees := 0.00; // déclinaison Result.IdxCouleur := 1; // couleur Result.Commentaire := C; // commentaire end; function TToporobotStructure2012.MakeCode0(const N: TNumeroExpe; const C: string): TCode; begin Result.setUsualParameters(N, UNITE_ANGULAIRE_DU_CODE_ZERO, UNITE_ANGULAIRE_DU_CODE_ZERO, 1.00, 0.05, 1.0, 1.0, 0.0, 0.0, 0.0, C); Result.ParamsFuncCorrAz.Empty(); Result.ParamsFuncCorrInc.Empty(); end; // méthodes relatives aux expés //------------------------------------------ procedure TToporobotStructure2012.AddExpe(constref LaExpe: TExpe); begin FTableExpes.AddElement(LaExpe); end; procedure TToporobotStructure2012.PutExpe(const Idx: integer; constref LaExpe: TExpe); begin FTableExpes.PutElement(Idx, LaExpe); end; function TToporobotStructure2012.GetExpe(const Idx: integer): TExpe; begin Result := FTableExpes.GetElement(Idx); end; function TToporobotStructure2012.GetExpeByNumero(const NumeroExpe: TNumeroExpe): TExpe; var QIdx: integer; begin if (not FTableExpes.FindElementByNumero(NumeroExpe, Result, QIdx)) then Result := FTableExpes.GetElement(0); end; function TToporobotStructure2012.GetNbExpes(): integer; begin Result := FTableExpes.GetNbElements; end; function TToporobotStructure2012.CreateNouveauExpe(): boolean; var EWE: TExpe; nb: Integer; begin result := false; try nb := GetNbExpes; EWE := GetExpe(nb - 1); EWE.IDExpe := 1 + getMaxIdxExpe(); EWE.Commentaire := 'Nouvelle expe'; self.AddExpe(EWE); result := true; except end; end; function TToporobotStructure2012.GetLastExpe(): TExpe; var Nb: Integer; begin Nb := self.GetNbExpes - 1; Result := GetExpe(Nb); end; function TToporobotStructure2012.RemoveExpe(const Idx: integer): boolean; begin Result := FTableExpes.RemoveElement(Idx); end; // méthodes relatives aux codes //------------------------------------------ procedure TToporobotStructure2012.AddCode(constref LeCode: TCode); begin FTableCodes.AddElement(LeCode); end; function TToporobotStructure2012.GetCode(const Idx: integer): TCode; begin Result := FTableCodes.GetElement(Idx); end; //------------------------------------------ function TToporobotStructure2012.GetCodeByNumero(const NumeroCode: TNumeroCode): TCode; var QIdx: integer; begin if (not FTableCodes.FindElementByNumero(NumeroCode, Result, QIdx)) then Result := FTableCodes.GetElement(0); end; procedure TToporobotStructure2012.PutCode(const Idx: integer; constref LeCode: TCode); begin FTableCodes.PutElement(Idx, LeCode); end; function TToporobotStructure2012.RemoveCode(const Idx: integer): boolean; begin Result := FTableCodes.RemoveElement(Idx); end; function TToporobotStructure2012.GetNbCodes(): integer; begin Result := FTableCodes.GetNbElements(); end; function TToporobotStructure2012.CreateNouveauCode(): boolean; var nb: Integer; EWE: TCode; begin result := false; try nb := GetNbCodes; EWE := GetCode(nb - 1); EWE.IDCode := 1 + getMaxIdxCode; EWE.Commentaire := 'Nouveau code'; self.AddCode(EWE); result := true; except end; end; function TToporobotStructure2012.GetLastCode(): TCode; var Nb: Integer; begin Nb := self.GetNbCodes - 1; Result := GetCode(Nb); end; // méthodes relatives aux antennes procedure TToporobotStructure2012.AddViseeAntenne(constref VA: TViseeAntenne); begin FTableViseesAntenne.AddElement(VA); end; function TToporobotStructure2012.GetViseeAntenne(const No: integer): TViseeAntenne; begin Result := FTableViseesAntenne.GetElement(No); end; procedure TToporobotStructure2012.PutViseeAntenne(const No: integer; const VA: TViseeAntenne); begin FTableViseesAntenne.PutElement(No, VA); end; function TToporobotStructure2012.ReattribuerCodesExpesViseesAntennes(): boolean; var PreviousViseeAntenne, MyViseeAntenne: TViseeAntenne; Nb, i, QIdxSerie: Integer; WU, SameBasePt: Boolean; MySerie: TObjSerie; MyStation: TUneVisee; T: TDateTime; begin result := false; AfficherMsgClass(self, 'ReattribuerCodesExpesViseesAntennes()'); Nb := GetNbAntennes(); if (Nb <= 1) then Exit(false); MyViseeAntenne := GetViseeAntenne(0); WU := GetSerieByNumeroSerie(MyViseeAntenne.SerieDepart, MySerie, QIdxSerie); MyStation := MySerie.GetVisee(MyViseeAntenne.PtDepart); T := now(); AfficherMessage(DateTimeToStr(T)); for i := 1 to Nb - 1 do begin try PreviousViseeAntenne := GetViseeAntenne(i-1); MyViseeAntenne := GetViseeAntenne(i); // les extractions de série/stations sont coûteuses et ne doivent être effectuées // que si les basepoint des antennes n et n-1 diffèrent SameBasePt := (MyViseeAntenne.SerieDepart = PreviousViseeAntenne.SerieDepart) and (MyViseeAntenne.PtDepart = PreviousViseeAntenne.PtDepart); if ((i = 1) or (not SameBasePt)) then begin WU := GetSerieByNumeroSerie(MyViseeAntenne.SerieDepart, MySerie, QIdxSerie); MyStation := MySerie.GetVisee(MyViseeAntenne.PtDepart); end; // on reporte les code, expé, réseau et secteur de la station d'accrochage MyViseeAntenne.Reseau := MySerie.NumeroReseau; MyViseeAntenne.Secteur := MyStation.IDSecteur; // et on actualise PutViseeAntenne(i, MyViseeAntenne); Result := True; except pass; end; end; AfficherMessage(TimeToStr(Now() - T)); end; function TToporobotStructure2012.RemoveViseeAntenne(const No: integer): boolean; begin Result := FTableViseesAntenne.RemoveElement(No); end; function TToporobotStructure2012.RemoveLastViseeAntenne(): boolean; begin Result := FTableViseesAntenne.RemoveLastElement(); end; function TToporobotStructure2012.GetNbAntennes(): integer; begin Result := FTableViseesAntenne.GetNbElements; end; // supprimer les antennes orphelines // et celles dont le numéro serie/station est spécifié (si qIdxSerie > 0) // longMax: Longueur au-delà de laquelle la visée est supprimée function TToporobotStructure2012.NettoyerAntennes(const longMax: double; const qIdxSerie, qIdxStation: integer): integer; var EWE: TViseeAntenne; n: Integer; B0, B1, B2, B3, B00: boolean; CurrSer: TNumeroSerie; CurrSt : TNumeroStation; begin Result := 0; AfficherMsgClass(self, 'NettoyerAntennes(): %.3f (origine: %d.%d)', [longMax, qIdxSerie, qIdxStation]); self.SortAntennesBySerieStation(); CurrSer := -1; CurrSt := -1; for n := FTableViseesAntenne.Count - 1 downto 0 do begin EWE := GetViseeAntenne(n); // la recherche ne se fait que si la station d'accrochage de l'antenne et la station courante sont différents // HasStationForAntennaShot() est coûteuse B00 := (EWE.SerieDepart <> CurrSer) OR (EWE.PtDepart <> CurrSt); if (B00) then begin B2 := Not HasStationForAntennaShot(EWE); CurrSer := EWE.SerieDepart; CurrSt := EWE.PtDepart; end; B0 := (0 = EWE.PtDepart); B1 := not IsInRange(EWE.Longueur, 0.01, longMax); B3 := false; if (Assigned(FProcDispProgression) and (n mod 1000 = 0)) then FProcDispProgression('Antennes', n, 0, FTableViseesAntenne.Count, 500); if (qIdxSerie > 0) then B3 := (EWE.SerieDepart = qIdxSerie) and (EWE.PtDepart = qIdxStation); if (B0 or B1 or B2 or B3) then begin RemoveViseeAntenne(n); AfficherMessageErreur('Antenne retiree: %d.%d', [EWE.SerieDepart, EWE.PtDepart]); Result := Result + 1; end; end; FTableViseesAntenne.Compacter(); AfficherMessage('%d antennes supprimées', [Result]); end; function TToporobotStructure2012.ExistsIdxCode(const NumCode: TNumeroCode): boolean; begin Result := FTableCodes.ExistsElement(NumCode); end; function TToporobotStructure2012.ExistsIdxExpe(const NumExpe: TNumeroExpe): boolean; begin Result := FTableExpes.ExistsElement(NumExpe); end; function TToporobotStructure2012.ExistsIdxSerie(const NumSerie: TNumeroSerie): boolean; var EWE: TObjSerie; i: Integer; begin Result := False; for i:= 0 to self.GetNbSeries() - 1 do begin EWE := self.GetSerie(i); if (EWE.NumeroDeSerie = NumSerie) then Exit(True); end; end; function TToporobotStructure2012.HasDoublonsInCodes(out ArrOfIdx: TArrayOfIntegers): boolean; var i: Integer; begin AfficherMsgErrClass(self, 'HasDoublonsInCodes(): %d codes', [FTableCodes.GetNbElements()]); result := FTableCodes.HasDoublons(ArrOfIdx); if (result) then begin AfficherMessageErreur('La table contient %d doublons', [ArrOfIdx.getNbElements()]); for i := 0 to ArrOfIdx.getNbElements() - 1 do begin AfficherMessageErreur(' -- %d: %d', [i, ArrOfIdx.getFrom(i)]); end; end; end; function TToporobotStructure2012.HasDoublonsInExpes(out ArrOfIdx: TArrayOfIntegers): boolean; var i: Integer; begin AfficherMsgErrClass(self, 'HasDoublonsInExpes(): %d expes', [FTableCodes.GetNbElements()]); result := FTableExpes.HasDoublons(ArrOfIdx); if (result) then begin AfficherMessageErreur('La table contient %d doublons', [ArrOfIdx.getNbElements()]); for i := 0 to ArrOfIdx.getNbElements() - 1 do begin AfficherMessageErreur(' -- %d: %d', [i, ArrOfIdx.getFrom(i)]); end; end; end; function TToporobotStructure2012.ExistsIdxReseau(const Idx: integer): boolean; begin Result := (Idx < FTableReseaux.GetNbElements()); end; function TToporobotStructure2012.ExistsIdxEntrance(const Idx: integer): boolean; begin Result := (Idx < FTableEntrances.GetNbElements()); end; function TToporobotStructure2012.GetLastFindText(): string; begin Result := FLastFindTextWhat; end; //------------------------------------------------------------------------------ // check des données // retourne le nombre d'erreurs function TToporobotStructure2012.CheckerLesDonneesTopo(const BDDEntites: TBDDEntites): Integer; begin Result := 0; AfficherMsgClass(self, 'CheckerLesDonneesTopo()'); FListeMessagesErreur.ClearListe(); CheckerLesCodes(); CheckerLesExpes(); CheckerLesEntrees(); // scan des entrées CheckerLesSeries(BDDEntites); // scan des séries CheckerLesAntennes(); Result := FListeMessagesErreur.GetNbElements(); end; procedure TToporobotStructure2012.CheckerLesEntrees(); var UneEntree: TEntrance; Nb, i: Integer; begin Nb := GetNbEntrances(); AfficherMsgClass(self, 'CheckerLesEntrees(): %d entrances',[Nb]); if (Nb = 0) then begin UneEntree.eNomEntree := 'Entree par default'; UneEntree.ePosition := self.FPositionPointZero; UneEntree.eCouleur := clYellow; UneEntree.eRefSer := 1; UneEntree.eRefSt := 0; UneEntree.eObserv := 'Entree reparee'; self.AddEntrance(UneEntree); AddMessageErreur(tmeENTRANCES, cmeNOTE, 0, 'Entrée 0 ajoutée'); end; for i := 0 to Nb - 1 do begin UneEntree := GetEntrance(i); if (IsZero(UneEntree.ePosition.X)) then AddMessageErreur(tmeENTRANCES, cmeERROR, i, Format('%s: Coordonnée X nulle: %.2f', [UneEntree.eNomEntree, UneEntree.ePosition.X])); if (IsZero(UneEntree.ePosition.Y)) then AddMessageErreur(tmeENTRANCES, cmeERROR, i, Format('%s: Coordonnée Y nulle: %.2f', [UneEntree.eNomEntree, UneEntree.ePosition.Y])); if (IsZero(UneEntree.ePosition.Z)) then AddMessageErreur(tmeENTRANCES, cmeERROR, i, Format('%s: Coordonnée Z nulle: %.2f', [UneEntree.eNomEntree, UneEntree.ePosition.Z])); end; end; // 21/08/2017: Ajout de la détection des doublons dans les numéros de séries // 17/07/2024: Détection de discordances entre la longueur de série calculée par TObjSerie et celle déterminée d'après le plan procedure TToporobotStructure2012.CheckerLesSeries(const BDDEntites: TBDDEntites); var ArrOfIdx: TArrayOfIntegers; MySerieCourante: TObjSerie; i, Nb, NbreDeStations, EWE, QQ, QIdx: Integer; WU: String; begin Nb := GetNbSeries(); NbreDeStations := 0; AfficherMsgClass(self, 'CheckerLesSeries: %d series',[ Nb]); if (Assigned(BDDEntites)) then BDDEntites.SortBySerSts(); // détection des doublons if (HasDoublonsInNumsSeries(ArrOfIdx)) then begin for i := 0 to ArrOfIdx.getNbElements() - 1 do begin GetSerieByNumeroSerie(ArrOfIdx.getFrom(i), MySerieCourante, QIdx); AddMessageErreur(tmeSERIES, cmeCRITICAL, MySerieCourante.NumeroDeSerie, Format(GetResourceString(rsCHK_MSG_DOUBLON_SERIE), // rsCHK_MSG_DOUBLON_SERIE = 'Doublon dans le numéro de série: %d: %d - %s'; [i, MySerieCourante.NumeroDeSerie, MySerieCourante.NomSerie])); end; end; for i := 1 to Nb - 1 do begin MySerieCourante := GetSerie(i); NbreDeStations := NbreDeStations + MySerieCourante.NbVisees; QQ := CheckSerie(MySerieCourante, BDDEntites); if (0 = (i mod 200)) then AfficherMessageErreur(' -- Serie: %d', [MySerieCourante.NumeroDeSerie]); end; if (Assigned(BDDEntites)) then BDDEntites.SortByDepth(); if (NbreDeStations < 2) then AddMessageErreur(tmeSERIES, cmeWARNING, 0, Format(GetResourceString(rsCHK_MSG_SERIE_NB_STATIONS_WARNING), [NbreDeStations])) else AddMessageErreur(tmeSERIES, cmeNOTE , 0, Format(GetResourceString(rsCHK_MSG_SERIE_NB_TOTAL_STATIONS), [NbreDeStations])); end; // Recherche de la première série invalide // (indispensable pour GHTopoLT: la majeure partie des 'spaghetti' après un recalcul provient d'une série vide) function TToporobotStructure2012.HasInvalidSerie(out QIdx: integer; out QSerie: TObjSerie): boolean; var i: Integer; begin result := false; for i := 1 to GetNbSeries() - 1 do begin QSerie := GetSerie(i); if ((QSerie.GetLongueurOfSerie() < 0.05) OR (QSerie.GetNbElements() < 2)) then begin QIdx := i; Exit(True); end; end; end; function TToporobotStructure2012.HasEntranceForStartingSerie(const S: TObjSerie): boolean; begin result := (self.FindIdxEntranceBySerSt(S.NoSerieDep, S.NoPointDep) > 0); end; // retourne: -1 si série vide; numéro de visée si erreur, 0 si OK function TToporobotStructure2012.CheckSerie(const MySerie: TObjSerie; const BDDEntites: TBDDEntites): integer; const SEUIL_SERIE_LONGUEUR_NULLE = 0.009; SEUIL_SERIE_TRES_COURTE = 0.10; MSG_ERR_ANGLE_INVALIDE = '-- %d.%d - %s invalide = %.3f a.u.'; MSG_ERR_LRUD_TOO_BIG = '-- %d.%d - %s grand = %.3f m'; MSG_ERR_ITEM_INEXISTANT = '-- %d.%d - %s inexistant = %d'; MSG_ERR_ITEM_INEXISTANT_FIXED = MSG_ERR_ITEM_INEXISTANT + ' - Nouvelle valeur %d'; var i, QNbVisees: Integer; MyVisee: TUneVisee; YaErreur: TSetErrorVisee; MessageRetour: string; QNumSerie: integer; QSerieDep, QPtDep: integer; QSerieArr, QPtArr: integer; QLongueurSerie, QOldLongueur: Double; B3: Boolean; procedure CompareLongueursSerie(); var B1, B2: Boolean; Nb, s: Integer; LongFromPlan, dL, dL_L: double; EE1, EE2: TBaseStation; P: TPoint3Df; QErrLongueurs: TCriticiteMessaqeErreurGHTopo; begin //AfficherMessageErreur(' --- Comparaison des longueurs de série: Lo = %.3f m', [QLongueurSerie]); Nb := MySerie.NbVisees; if (Nb < 2) then exit; B1 := BDDEntites.GetEntiteViseeFromSerSt(MySerie.NoSerieDep, MySerie.NoPointDep, EE1); B2 := BDDEntites.GetEntiteViseeFromSerSt(MySerie.NoSerieArr, MySerie.NoPointArr, EE2); if (not (B1 and B2)) then exit; LongFromPlan := 0.00; if (nb = 2) then begin P.SubstractAndSet(EE1.PosStation, EE2.PosStation); LongFromPlan += P.getNorme(); end else begin for s := 1 to Nb-1 do begin if (not BDDEntites.GetEntiteViseeFromSerSt(MySerie.NumeroDeSerie, s, EE2)) then Continue; LongFromPlan += EE2.CalcLongVisee(); end; B1 := BDDEntites.GetEntiteViseeFromSerSt(MySerie.NumeroDeSerie, Nb-1, EE1); B2 := BDDEntites.GetEntiteViseeFromSerSt(MySerie.NoSerieArr, MySerie.NoPointArr, EE2); if (B1 and B2) then begin P.SubstractAndSet(EE1.PosStation, EE2.PosStation); LongFromPlan += P.getNorme(); end; end; dL := QLongueurSerie - LongFromPlan; dL_L := 100 * dL / QLongueurSerie; if (dL_L >= 1.00) then begin if (InRange(dL_L, 1.0 , 2.0)) then QErrLongueurs := cmeNOTE; if (InRange(dL_L, 2.0 , 5.0)) then QErrLongueurs := cmeWARNING; if (InRange(dL_L, 5.0 , 20.0)) then QErrLongueurs := cmeERROR; if (dL_L > 20.0 ) then QErrLongueurs := cmeCRITICAL; AddMessageErreur(tmeSERIES, QErrLongueurs, QNumSerie, format('Discordance sur longueurs de cheminements: Lo = %.3f m - Lp = %.3f - dL = %.3f dL/L = %.2f%%', [QLongueurSerie, LongFromPlan, dL, dL_L])); end; end; begin Result := -1; QNbVisees := MySerie.NbVisees; //try QNumSerie := MySerie.NumeroDeSerie; QSerieDep := MySerie.NoSerieDep; QSerieArr := MySerie.NoSerieArr; QPtDep := MySerie.NoPointDep; QPtArr := MySerie.NoPointArr; // détection des auto-boucles (séries se refermant sur elles-mêmes) if (MySerie.HasAutoloop()) then AddMessageErreur(tmeSERIES, cmeWARNING, QNumSerie, Format(GetResourceString(rsCHK_MSG_AUTOLOOP), [QSerieArr, QNbVisees - 1, QNumSerie, QPtArr, MySerie.NbVisees - 1])); // détection des séries non raccordées // 1. Numéro de point de départ nul ? // 1.1: La série part d'une entrée // 1.2: La série arrive sur un noeud du réseau // 1.3: La série n'est pas raccordée B3 := (QPtDep = 0); if (B3) then begin if (HasEntranceForStartingSerie(MySerie)) then // 1.1: La série part d'une entrée ? begin AddMessageErreur(tmeSERIES, cmeNOTE, QNumSerie, Format(GetResourceString(rsCHK_MSG_SERIE_CNX_ENTREE), [QNumSerie, QSerieDep, QPtDep, ''])) end else if (HasPtTopoBySerSt(QSerieArr, QPtArr)) then begin AddMessageErreur(tmeSERIES, cmeNOTE, QNumSerie, Format(GetResourceString(rsCHK_MSG_SERIE_LINKED_TO) , [QNumSerie, QSerieDep, QPtDep, QSerieArr, QPtArr])); end else begin AddMessageErreur(tmeSERIES, cmeERROR, QNumSerie, Format(GetResourceString(rsCHK_MSG_SERIE_ORPHELINE), [QNumSerie, QSerieDep, QPtDep, QSerieArr, QPtArr])); end; end; if (not HasPtTopoBySerSt(QSerieDep, QPtDep)) then begin AddMessageErreur(tmeSERIES, cmeERROR, QNumSerie, Format(GetResourceString(rsCHK_MSG_SERIE_PT_DEP_OR_ARR_NOT_FOUND), [QNumSerie, 'départ', QSerieDep, QPtDep, QSerieArr, QPtArr])); end; if (not HasPtTopoBySerSt(QSerieArr, QPtArr))then begin AddMessageErreur(tmeSERIES, cmeERROR, QNumSerie, Format(GetResourceString(rsCHK_MSG_SERIE_PT_DEP_OR_ARR_NOT_FOUND), [QNumSerie, 'arrivée', QSerieDep, QPtDep, QSerieArr, QPtArr])); end; // scan de la table des visées QLongueurSerie := 0.00; if (QNbVisees = 0) then begin // série sans visées AddMessageErreur(tmeSERIES, cmeCRITICAL, QNumSerie, Format(GetResourceString(rsCHK_MSG_SERIE_WITHOUT_SHOTS), [QNumSerie])); Exit(-1); end; for i := 0 to QNbVisees - 1 do begin MyVisee := MySerie.GetVisee(i); QLongueurSerie := QLongueurSerie + MyVisee.Longueur; YaErreur := CheckVisee(MyVisee, MessageRetour); if (YaErreur <> []) then begin // visée 0 if (i = 0) then begin if (errvSECTEUR in YaErreur) then begin MyVisee.IDSecteur := 0; MySerie.PutVisee(0, MyVisee); AddMessageErreur(tmeSERIES, cmeERROR_AUTOFIXED, QNumSerie, Format(MSG_ERR_ITEM_INEXISTANT_FIXED, [QNumSerie, i, 'Secteur', MyVisee.IDSecteur, 0])); end; if (errvTYPEVISEE in YaErreur) then begin MyVisee.TypeVisee := tgDEFAULT; MySerie.PutVisee(0, MyVisee); AddMessageErreur(tmeSERIES, cmeERROR_AUTOFIXED, QNumSerie, Format(MSG_ERR_ITEM_INEXISTANT_FIXED, [QNumSerie, i, 'Type', ord(MyVisee.TypeVisee), Ord(tgDEFAULT)])); end; if (errvCODE in YaErreur) then begin MyVisee.Code := 1; MySerie.PutVisee(0, MyVisee); AddMessageErreur(tmeSERIES, cmeERROR_AUTOFIXED, QNumSerie, Format(MSG_ERR_ITEM_INEXISTANT_FIXED, [QNumSerie, i, 'Code', MyVisee.Code, 1])); end; if (errvEXPE in YaErreur) then begin MyVisee.Expe := 1; MySerie.PutVisee(0, MyVisee); AddMessageErreur(tmeSERIES, cmeERROR_AUTOFIXED, QNumSerie, Format(MSG_ERR_ITEM_INEXISTANT_FIXED, [QNumSerie, i, 'Expe', MyVisee.Expe, 1])); end; if (MyVisee.Longueur < SEUIL_LONGUEUR_NULLE) then begin MyVisee.Longueur := SEUIL_LONGUEUR_NULLE; MySerie.PutVisee(0, MyVisee); AddMessageErreur(tmeSERIES, cmeERROR_AUTOFIXED, QNumSerie, Format('%d.%d - Visée de longueur nulle mise à %.3f m', [QNumSerie, i, MyVisee.Longueur])); end; end else begin if (errvSECTEUR in YaErreur) then AddMessageErreur(tmeSERIES, cmeERROR, QNumSerie, Format(MSG_ERR_ITEM_INEXISTANT, [QNumSerie, i, 'Secteur', MyVisee.IDSecteur])); if (errvTYPEVISEE in YaErreur) then AddMessageErreur(tmeSERIES, cmeERROR, QNumSerie, Format(MSG_ERR_ITEM_INEXISTANT, [QNumSerie, i, 'Type', ord(MyVisee.TypeVisee)])); if (errvCODE in YaErreur) then AddMessageErreur(tmeSERIES, cmeERROR, QNumSerie, Format(MSG_ERR_ITEM_INEXISTANT, [QNumSerie, i, 'Code', MyVisee.Code])); if (errvEXPE in YaErreur) then AddMessageErreur(tmeSERIES, cmeERROR, QNumSerie, Format(MSG_ERR_ITEM_INEXISTANT, [QNumSerie, i, 'Expe', MyVisee.Expe])); if (errvLONGUEUR_NULLE in YaErreur) then begin QOldLongueur := MyVisee.Longueur; MyVisee.Longueur := 0.01; MySerie.PutVisee(i, MyVisee); AddMessageErreur(tmeSERIES, cmeERROR_AUTOFIXED, QNumSerie, Format('%d.%d - Visée de longueur nulle: %.3f m mise à %.3f', [QNumSerie, i, QOldLongueur, MyVisee.Longueur])); end; end; if (errvLONGUEUR_OVERFLOW in YaErreur) then AfficherMessageErreur('%d.%d - Length = %.3f m too big', [QNumSerie, i, MyVisee.Longueur]); if (errvAZIMUT in YaErreur) then AddMessageErreur(tmeSERIES, cmeERROR, QNumSerie, Format(MSG_ERR_ANGLE_INVALIDE, [QNumSerie, i, 'Azimut', MyVisee.Azimut])); if (errvPENTE in YaErreur) then AddMessageErreur(tmeSERIES, cmeERROR, QNumSerie, Format(MSG_ERR_ANGLE_INVALIDE, [QNumSerie, i, 'Inclinaison', MyVisee.Pente])); if (errvLG in YaErreur) then AddMessageErreur(tmeSERIES, cmeWARNING, QNumSerie, Format(MSG_ERR_LRUD_TOO_BIG, [QNumSerie, i, 'LG', MyVisee.LG])); if (errvLD in YaErreur) then AddMessageErreur(tmeSERIES, cmeWARNING, QNumSerie, Format(MSG_ERR_LRUD_TOO_BIG, [QNumSerie, i, 'LD', MyVisee.LD])); if (errvHZ in YaErreur) then AddMessageErreur(tmeSERIES, cmeWARNING, QNumSerie, Format(MSG_ERR_LRUD_TOO_BIG, [QNumSerie, i, 'HZ', MyVisee.HZ])); if (errvHN in YaErreur) then AddMessageErreur(tmeSERIES, cmeWARNING, QNumSerie, Format(MSG_ERR_LRUD_TOO_BIG, [QNumSerie, i, 'HN', MyVisee.HN])); // warnings: les LRUD data dépassent rarement 30 m if (errWarnLG in YaErreur) then AddMessageErreur(tmeSERIES, cmeWARNING, QNumSerie, Format(MSG_ERR_LRUD_TOO_BIG, [QNumSerie, i, 'LG', MyVisee.LG])); if (errWarnLD in YaErreur) then AddMessageErreur(tmeSERIES, cmeWARNING, QNumSerie, Format(MSG_ERR_LRUD_TOO_BIG, [QNumSerie, i, 'LD', MyVisee.LD])); if (errWarnHZ in YaErreur) then AddMessageErreur(tmeSERIES, cmeWARNING, QNumSerie, Format(MSG_ERR_LRUD_TOO_BIG, [QNumSerie, i, 'HZ', MyVisee.HZ])); if (errWarnHN in YaErreur) then AddMessageErreur(tmeSERIES, cmeWARNING, QNumSerie, Format(MSG_ERR_LRUD_TOO_BIG, [QNumSerie, i, 'HN', MyVisee.HN])); end; end; // longueur de série très faible -> avertir (il peut s'agir d'une série fictive, typiquement pour relier deux séries qui se croisent) if (QLongueurSerie < SEUIL_SERIE_TRES_COURTE) then AddMessageErreur(tmeSERIES, cmeWARNING , QNumSerie, Format(GetResourceString(rsCHK_MSG_VISEE_TRES_COURTE), [QNumSerie, QNbVisees, QLongueurSerie, SEUIL_SERIE_TRES_COURTE])); // longueur de série quasi nulle -> considérer comme une erreur if (QLongueurSerie < SEUIL_SERIE_LONGUEUR_NULLE) then AddMessageErreur(tmeSERIES, cmeCRITICAL, QNumSerie, Format(GetResourceString(rsCHK_MSG_SERIE_DEV_NUL) , [QNumSerie, QNbVisees])); // Si BDDEntites est défini, déterminer la série d'après le plan if (Assigned(BDDEntites)) then CompareLongueursSerie(); //except //end; end; function TToporobotStructure2012.FixerViseesDeLongueurNulle(): integer; var MySerie: TObjSerie; i, NbSeries: Integer; v, NbVisees: integer; MyVisee: TUneVisee; begin Result := 0; NbSeries := self.GetNbSeries(); AfficherMsgClass(self, 'FixerViseesDeLongueurNulle(): %d series', [NbSeries]); for i := 1 to NbSeries - 1 do begin MySerie := self.GetSerie(i); NbVisees:= MySerie.NbVisees; for v := 0 to NbVisees - 1 do begin MyVisee := MySerie.GetVisee(v); if (MyVisee.Longueur < SEUIL_LONGUEUR_NULLE) then begin Inc(Result); AfficherMessageErreur('Station: %d.%d: Longueur de visée nulle (%.3f), mise à %.3f', [MySerie.NumeroDeSerie, v, MyVisee.Longueur, SEUIL_LONGUEUR_NULLE]); MyVisee.Longueur := SEUIL_LONGUEUR_NULLE; MySerie.PutVisee(v, MyVisee); end; end; end; AfficherMessageErreur('--------------------'); AfficherMessageErreur('%d erreurs fixées', [Result]); end; function TToporobotStructure2012.FixerEntrancesWithoutValidRef(): integer; var i, NbEntrances, NbErrFixed: Integer; MyEntrance: TEntrance; EWE1, EWE2: Boolean; begin Result := 0; NbEntrances := self.GetNbEntrances(); AfficherMsgErrClass(self, 'FixerEntrancesWithoutRef(): %d entrances', [NbEntrances]); NbEntrances := Self.GetNbEntrances(); if (NbEntrances <= 1) then exit; for i := NbEntrances - 1 downto 1 do begin MyEntrance := GetEntrance(i); EWE1 := (0 = MyEntrance.eRefSer) AND (0 = MyEntrance.eRefSt); // entrée mal référencée Serie/station EWE2 := (MyEntrance.ePosition.getProjHZ() < 10.00); // entrée non géoréférencée if (EWE1 or EWE2) then begin Inc(Result); AfficherMessageErreur('Removed entrance %d: %s [ref %d.%d] %s ', [i, MyEntrance.eNomEntree, MyEntrance.eRefSer, MyEntrance.eRefSt, MyEntrance.ePosition.DebugString('Position')]); RemoveEntrance(i); end; end; AfficherMessageErreur('--------------------'); AfficherMessageErreur('%d erreurs fixées', [Result]); //GetLast end; function TToporobotStructure2012.FixerLesAutoloops(): integer; var i, NbSeries, NbErrFixed, NbV: Integer; MySerie: TObjSerie; MyStationArrivee : TToporobotIDStation; EWE: String; MyVisee: TUneVisee; begin Result := 0; NbSeries := self.GetNbSeries(); AfficherMsgErrClass(self, 'FixerLesAutoloops(): %d series', [NbSeries]); for i := 1 to NbSeries - 1 do begin MySerie := GetSerie(i); if (MySerie.HasAutoloop()) then begin Inc(Result); NbV := MySerie.NbVisees; MyStationArrivee.setFrom(MySerie.NoSerieArr, MySerie.NoPointArr); AfficherMessageErreur('Autoloop fixed for %d: %s (%s)', [MySerie.NumeroDeSerie, MySerie.NomSerie, MyStationArrivee.ToString()]); EWE := MySerie.ObsSerie; MySerie.SetObsSerie(EWE + ' *** Autoloop fixed for ' + MyStationArrivee.ToString()); MyVisee := MySerie.GetVisee(NbV - 1); MyVisee.Commentaires := MyVisee.Commentaires + '=' + MyStationArrivee.ToString(); MySerie.PutVisee(NbV - 1, MyVisee); MySerie.SetNoPointArr(NbV - 1); // Pas de PutSerie: TObjSerie est un pointeur; end; end; AfficherMessageErreur('--------------------'); AfficherMessageErreur('%d erreurs fixées', [Result]); end; function TToporobotStructure2012.FixerExtremitesSeriesAt0and0(): integer; var i, NbSeries, NbErrFixed, NbV: Integer; MySerie: TObjSerie; EWE: String; MyStationArrivee : TToporobotIDStation; begin Result := 0; NbSeries := self.GetNbSeries(); AfficherMsgErrClass(self, 'FixerExtremitesSeriesAt0and0(): %d series', [NbSeries]); for i := 1 to NbSeries - 1 do begin MySerie := GetSerie(i); if (0 = MySerie.NoSerieArr) then begin Inc(Result); NbV := MySerie.NbVisees; MyStationArrivee.setFrom(MySerie.NoSerieArr, MySerie.NoPointArr); AfficherMessageErreur('Null termination fixed for %d: %s (%s)', [MySerie.NumeroDeSerie, MySerie.NomSerie, MyStationArrivee.ToString()]); EWE := MySerie.ObsSerie; MySerie.SetObsSerie(EWE + ' *** Bad terminus fixed for ' + MyStationArrivee.ToString()); MySerie.SetSeriePtArr(MySerie.NumeroDeSerie, NbV - 1); // Pas de PutSerie: TObjSerie est un pointeur; end; end; AfficherMessageErreur('--------------------'); AfficherMessageErreur('%d erreurs fixées', [Result]); end; function TToporobotStructure2012.CheckVisee(constref V: TUneVisee; out MsgErr: string): TSetErrorVisee; const SBOUB = 'Warning: %.3f exceeds %.3f'; var MyCode: TCode; MyExpe: TExpe; WU: Int64; miou: double; CC: Integer; EE: Integer; MaxAzimutAccepte: double; function EWE(const QMsg: string; const QMini, QMaxi: double; const QUnit: string): string; begin Result := Format(rsCHECK_VISEE_VALID_INTERVAL + #13#10, [QMsg, QMini, QUnit, QMaxi, QUnit]); end; procedure MiouMiou(const E: TSetErrorVisee; const M: string); begin MsgErr := MsgErr + M; Result := Result + E; end; begin MsgErr := ''; Result := []; // on teste d'abord ce qui est indépendant des expés et codes if (not IsInRange(Ord(V.TypeVisee), 0, Ord(tgIGNORED_FOR_GRAPHE))) then MiouMiou([errvTYPEVISEE] , Format(rsCHECK_VISEE_VALID_TYPE_VISEE + #13#10, [0, Ord(tgIGNORED_FOR_GRAPHE)])); if (V.Longueur < SEUIL_LONGUEUR_NULLE) then MiouMiou([errvLONGUEUR_NULLE] , Format('Longueur = %.2f m', [V.Longueur])); if (V.Longueur > SEUIL_LONGUEUR_MAXI_TOPOROBOT) then MiouMiou([errvLONGUEUR_OVERFLOW] , Format('Longueur = %.2f m', [V.Longueur])); if (not IsInRange(V.LG, 0.00, SEUIL_LONGUEUR_MAXI_TOPOROBOT)) then MiouMiou([errvLG] , EWE('Left distance', 0.00, SEUIL_LONGUEUR_MAXI_TOPOROBOT, 'm')); if (not IsInRange(V.LD, 0.00, SEUIL_LONGUEUR_MAXI_TOPOROBOT)) then MiouMiou([errvLD] , EWE('Right distance', 0.00, SEUIL_LONGUEUR_MAXI_TOPOROBOT, 'm')); if (not IsInRange(V.HZ, 0.00, SEUIL_LONGUEUR_MAXI_TOPOROBOT)) then MiouMiou([errvHZ] , EWE('Upper distance', 0.00, SEUIL_LONGUEUR_MAXI_TOPOROBOT, 'm')); if (not IsInRange(V.HN, 0.00, SEUIL_LONGUEUR_MAXI_TOPOROBOT)) then MiouMiou([errvHN] , EWE('Downer distance', 0.00, SEUIL_LONGUEUR_MAXI_TOPOROBOT, 'm')); if (V.LG > SEUIL_LRUD_WARN_LENGTH) then MiouMiou([errWarnLG] , Format(SBOUB, [V.LG, SEUIL_LRUD_WARN_LENGTH])); if (V.LD > SEUIL_LRUD_WARN_LENGTH) then MiouMiou([errWarnLD] , Format(SBOUB, [V.LD, SEUIL_LRUD_WARN_LENGTH])); if (V.HZ > SEUIL_LRUD_WARN_LENGTH) then MiouMiou([errWarnHZ] , Format(SBOUB, [V.HZ, SEUIL_LRUD_WARN_LENGTH])); if (V.HN > SEUIL_LRUD_WARN_LENGTH) then MiouMiou([errWarnHN] , Format(SBOUB, [V.HN, SEUIL_LRUD_WARN_LENGTH])); // existence de secteurs, codes et expés if (GetIdxSecteurByNumero(V.IDSecteur) = -1) then Result := Result + [errvSECTEUR]; CC := GetIdxCodeByNumero(V.Code); EE := GetIdxExpeByNumero(V.Expe); if ((CC = -1) OR (EE = -1)) then begin if (CC = -1) then Result := Result + [errvCODE]; if (EE = -1) then Result := Result + [errvEXPE]; AfficherMessageErreur(' -- Invalid code (%d) or trip (%d) -> check aborted', [CC, EE]); Exit; end; // codes, secteur et expés MyCode := GetCodeByNumero(V.Code); MyExpe := GetExpeByNumero(V.Expe); // azimuts case Trunc(MyCode.GradAz) of 349, 350, 359, 360, 361: MaxAzimutAccepte := 360.00; 389, 390, 399, 400, 401: MaxAzimutAccepte := 400.00; else MaxAzimutAccepte := 400.00; end; if (not IsInRange(V.Azimut, 0.00, MaxAzimutAccepte)) then MiouMiou([errvAZIMUT] , EWE('Azimuth', 0.00, MaxAzimutAccepte, 'a.u.')); // pentes (le gros morceau) WU := Trunc(MyCode.GradInc); miou := MyCode.GradInc / 4; // quart de cercle dans l'unité de GradInc case WU of 360, 400: // clinos classiques degré et grades if (not IsInRange(V.Pente, -miou, +miou)) then MiouMiou([errvPENTE] , EWE('Inclination', -miou, +miou, 'a.u.')); 790, 800: // Lasermètres Stanley TLM330, directes et inverses if (not IsInRange(V.Pente, -SEUIL_LONGUEUR_MAXI_TOPOROBOT, +SEUIL_LONGUEUR_MAXI_TOPOROBOT)) then MiouMiou([errvPENTE], EWE('Difference in height', -miou, +miou, 'a.u.')); else pass; end; end; //*********************************** // recherche de l'index correspondant à un élément function TToporobotStructure2012.GetIdxEntreeByNumero(const N: TNumeroEntrance): integer; begin Result := n; end; function TToporobotStructure2012.GetIdxReseauByNumero(const N: TNumeroReseau): integer; begin Result := n; end; function TToporobotStructure2012.GetIdxSecteurByNumero(const N: TNumeroSecteur): integer; begin Result := n; end; function TToporobotStructure2012.GetIdxCodeByNumero(const N: TNumeroCode): integer; var i : integer; EWE: TCode; begin Result := -1; for i := 0 to GetNbCodes - 1 do begin EWE := GetCode(i); if (EWE.IDCode = N) then Exit(i); end; end; function TToporobotStructure2012.GetIdxExpeByNumero(const N: TNumeroExpe): integer; var i : integer; EWE: TExpe; begin Result := -1; for i := 0 to GetNbExpes - 1 do begin EWE := GetExpe(i); if (EWE.IDExpe = N) then Exit(i); end; end; function TToporobotStructure2012.GetIdxSerieByNumero(const qIdx: TNumeroSerie): integer; var Nb: Integer; i: Integer; EWE: TObjSerie; begin Result := -1; Nb := self.GetNbSeries; if (Nb = 0) then exit; try for i := 0 to Nb - 1 do begin EWE := self.GetSerie(i); if (qIdx = EWE.NumeroDeSerie) then Exit(i); end; except end; end; //------------------------------------------------------------------------------ function TToporobotStructure2012.HasPtTopoBySerSt(const qSr: TNumeroSerie; const qPt: TNumeroStation): boolean; var S, P: Integer; mySerie: TObjSerie; EWE: TNumeroSerie; begin Result := False; for S := 0 to GetNbSeries() - 1 do begin mySerie := GetSerie(S); EWE := mySerie.NumeroDeSerie; for P := 0 to mySerie.NbVisees - 1 do begin if ((qSr = EWE) and (qPt = P)) then begin Result := True; //AfficherMessage('Station found in %d.%d', [mySerie.NumeroDeSerie, P]); Exit; end; end; end; end; // Y a t il un point topo connu à l'extrémité de fin de la série courante ? ( = la station d'arrivée n'est pas un cul de sac) function TToporobotStructure2012.SerieConnectedAtOther(const qCurrNumSr: TNumeroSerie; out QSR: TNumeroSerie; out QPT: TNumeroStation): boolean; var S: Integer; mySerie, CurrSerie: TObjSerie; QIdx: Integer; begin Result := False; QSR := -1; QPT := -1; if (not GetSerieByNumeroSerie(qCurrNumSr, CurrSerie, QIdx)) then exit(False); for S := 0 to GetNbSeries() - 1 do begin mySerie := GetSerie(S); // parcours des arrivées if (mySerie.NumeroDeSerie <> CurrSerie.NumeroDeSerie) and (MySerie.NumeroDeSerie = CurrSerie.NoSerieArr) then begin QSR := MySerie.NoSerieArr; QPT := MySerie.NoPointArr; Exit(True); end; end; end; // recherche du couple série station d'après ID littéral function TToporobotStructure2012.FindPtTopoByCle(const DoMatchExact: boolean; var Cle: string; out Sr: TNumeroSerie; out Pt: integer): boolean; var //Clef: string; S, P: integer; Q, R: string; mySerie: TObjSerie; myPoint : TUneVisee; WU: integer; N: Integer; S1, S2: String; QFound: Boolean; QSer: TNumeroSerie; qSt: TNumeroStation; begin Result := False; Sr := -1; Pt := -1; Cle := UpperCase(Trim(Cle)); // analyse de la clé: présumée de la forme S.P (Toporobot policy) if (ExtractSerStFromStr(Cle, QSer, qSt)) then; begin //ExtractSerStFromStr(Cle, QSr, qSt); (* N := Length(Cle); S1 := Trim(Copy(Cle, 0, WU - 1)); S2 := Trim(Copy(Cle, WU + 1, N)); qSer := StrToIntDef(S1, -1); qSt := StrToIntDef(S2, -1); //*) if (HasPtTopoBySerSt(qSer, qSt)) then begin Sr := qSer; Pt := qSt; Exit(True); end; end; // station non trouvee ? Tentative de Recherche par clé if ((Sr = -1) or (Pt = -1)) then AfficherMessageErreur(Cle); Result := False; for S := 0 to GetNbSeries - 1 do begin mySerie := GetSerie(S); for P := 0 to mySerie.NbVisees - 1 do begin myPoint := mySerie.GetVisee(P); // recherche sur IDTerrain et commentaires Q := UpperCase(Trim(myPoint.IDTerrainStation + '|' + myPoint.Commentaires)); // recherche sur une partie de la clé R := UpperCase(Trim(myPoint.IDTerrainStation)); // recherche exacte QFound := IIF(DoMatchExact, (R = Cle), (Pos(Cle, Q) > 0)); if (QFound) then begin Sr := mySerie.NumeroDeSerie; Pt := P; Cle := Q; Exit(True); end; end; end; end; // recherche dans les Ser.St et ID littéraux - Retourne une liste de visées function TToporobotStructure2012.FindPtsTopoByCle(const DoMatchExact: boolean; const Cle: string; out LS: TListeOfBipointsBaseStation): integer; var mySerie: TObjSerie; QBasepoint0: TBaseStation; QBasepoint1: TBaseStation; myStation0: TUneVisee; myStation1: TUneVisee; S, P: Integer; Q, R: String; QFound: Boolean; BP: TBipointBaseStation; function QMakeBP(constref V: TUneVisee): TBaseStation; begin Result.Empty(); Result.setSerPt(mySerie.NumeroDeSerie, P); Result.IDTerrain := V.IDTerrainStation; Result.TagString1 := mySerie.NomSerie; Result.TagString2 := V.Commentaires; end; begin Result := 0; AfficherMsgErrClass(self, 'FindPtsTopoByCle: %s', [Cle]); if ('' = Trim(Cle)) then exit; try //if (not assigned(LS)) then raise Exception.Create('L''objet LS, de type TTableEntitesVisees, doit être créé avant d''utiliser cette fonction'); LS.ClearListe(); for S := 1 to GetNbSeries - 1 do begin mySerie := GetSerie(S); for P := 1 to mySerie.NbVisees - 1 do begin myStation0 := mySerie.GetVisee(P-1); myStation1 := mySerie.GetVisee(P); // recherche sur IDTerrain et commentaires Q := Trim(myStation1.IDTerrainStation + '|' + myStation1.Commentaires); // recherche sur une partie de la clé R := format('%d.%d', [mySerie.NumeroDeSerie, P]); QFound := (Pos(Cle, Q) > 0) OR (Pos(Cle, R) > 0) ; if (QFound) then begin QBasepoint0 := QMakeBP(myStation0); QBasepoint1 := QMakeBP(myStation1); BP.setfrom(QBasepoint0, QBasepoint1); LS.AddElement(BP); AfficherMessageErreur(BP.debugString()); end; end; end; // S := 0 to GetNbSeries - 1 do Result := LS.Count; except end; end; // Spécifique Coume: Recherche des stations en relation avec les stations de fin de séries // C'est pour cette fonction que le TBipointBaseStation existe function TToporobotStructure2012.FindPtsTopoByLastStationsOfSeries(out LS: TListeOfBipointsBaseStation): integer; var S: Integer; mySerie: TObjSerie; myStationOfEndSerie: TUneVisee; Cle: String; // Pour un ID de la forme StFrom-StTo, retourne StTo // S'il n'y a de séparateur, retourne l'ID complet function QExtractPtArr(const ID: string; const SepFromTo: char = '-'): string; var PS: SizeInt; begin Result := Trim(ID); PS := Pos(SepFromTo, Result); if (PS = 0) then exit(Result); Result := System.Copy(Result, PS+1, Length(Result)); end; procedure QParcourirSeries(const QCle: string); var i, p: Integer; ASerie: TObjSerie; ACle, Q: String; AStation: TUneVisee; QFound: Boolean; BP: TBipointBaseStation; function QMakeBP(constref V: TUneVisee): TBaseStation; begin Result.Empty(); Result.setSerPt(ASerie.NumeroDeSerie, P); Result.IDTerrain := V.IDTerrainStation; Result.TagString1 := ASerie.NomSerie; Result.TagString2 := V.Commentaires; end; begin for i := 1 to GetNbSeries - 1 do begin ASerie := GetSerie(i); for p := 1 to ASerie.NbVisees - 1 do begin AStation := ASerie.GetVisee(p); ACle := QExtractPtArr(AStation.IDTerrainStation, '-'); if ('' = ACle) then Continue; // Clé vide ? Next Q := Trim(QCle); if (Q = '') then Continue; // Champ IDTerrain vide ? Next QFound := (Pos(ACle, Q) > 0); if (QFound) then begin BP.setfrom(QMakeBP(myStationOfEndSerie), QMakeBP(AStation)); LS.AddElement(BP); //AfficherMessageErreur(BP.DebugString()); end; end; end; //*) end; begin Result := 0; AfficherMsgErrClass(self, 'FindPtsTopoByLastStationsOfSeries():'); LS.ClearListe(); for S := 1 to GetNbSeries - 1 do begin try mySerie := GetSerie(S); myStationOfEndSerie := MySerie.GetLastVisee(); Cle := QExtractPtArr( myStationOfEndSerie.IDTerrainStation, '-'); AfficherMessageErreur(Cle + ' * ' + myStationOfEndSerie.IDTerrainStation); // On recherche sur la clé if (Cle = '') then Continue; QParcourirSeries(Cle); except end; end; // S := 0 to GetNbSeries - 1 do Result := LS.Count; end; function TToporobotStructure2012.FindIndexesSeriesRattachedAtSerie(const Idx: integer; out LS: TListOfIntegers): boolean; var n, i: Integer; MySerie, QSerie: TObjSerie; QNumSer: TNumeroSerie; begin Result := false; AfficherMsgClass(self, 'FindSeriesRattachedAtSerie(): %d', [Idx]); LS.ClearListe(); // par sécurité n := self.GetNbSeries(); MySerie := GetSerie(Idx); // attrapper la série courante QNumSer := MySerie.NumeroDeSerie; LS.AddElement(QNumSer); // on accroche en tête la série courante for i := 0 to n - 1 do begin QSerie := GetSerie(i); if (QNumSer = QSerie.NoSerieDep) then LS.AddElement(QSerie.NumeroDeSerie); if (QSerie.NoSerieArr = QNumSer) then LS.AddElement(QSerie.NumeroDeSerie); end; Result := (LS.Count > 0); end; // Infos sur les données topo function TToporobotStructure2012.GetNbTotalStations(): integer; var NbS, i: Integer; begin Result := 0; NbS := self.GetNbSeries(); for i := 1 to NbS-1 do Result += self.GetSerie(i).NbVisees; end; // ne nécessite pas de calcul topo // c'est du fichier de log -> messages en anglais uniquement function TToporobotStructure2012.GetInfosCavite(const LS: TStrings): integer; const FMTLNENTREE = FORMAT_NB_INTEGER+ FIELD_SEPARATOR_TAB + FORMAT_NB_REAL_2_DEC+ FIELD_SEPARATOR_TAB + FORMAT_NB_REAL_2_DEC+ FIELD_SEPARATOR_TAB + FORMAT_NB_REAL_2_DEC+ FIELD_SEPARATOR_TAB + FORMAT_STRING; FMTLNSER = FORMAT_NB_INTEGER+ FIELD_SEPARATOR_TAB + FORMAT_NB_INTEGER+ FIELD_SEPARATOR_TAB + FORMAT_NB_INTEGER+ FIELD_SEPARATOR_TAB + FORMAT_NB_INTEGER+ FIELD_SEPARATOR_TAB + FORMAT_NB_INTEGER+ FIELD_SEPARATOR_TAB + '%-60s' + FIELD_SEPARATOR_TAB + FORMAT_NB_INTEGER+ FIELD_SEPARATOR_TAB + FORMAT_NB_REAL_2_DEC+ FIELD_SEPARATOR_TAB + FORMAT_NB_REAL_2_DEC; var i, n: integer; E: TEntrance; Ser: TObjSerie; V: TUneVisee; D1, DevTotal: double; VolumeTotal : double; VolumeSerie : double; NbPtsTotal: Integer; begin Result:=-1; AfficherMsgClass(self, 'GetCaveInfoSeries()'); LS.Clear; try LS.Add(Format('File created %s - %s',[DateToStr(Now), TimeToStr(Now)])); LS.Add(''); LS.Add('Database : ' + FDatabaseName); LS.Add(''); LS.Add('Survey: ' + self.NomEtude); LS.Add(''); LS.Add(Format('List of %d entrances', [GetNbEntrances()])); LS.Add(''); for i := 0 to GetNbEntrances() - 1 do begin E := GetEntrance(i); LS.Add(Format(FMTLNENTREE, [i, E.ePosition.X, E.ePosition.Y, E.ePosition.Z, E.eNomEntree])); end; LS.Add(''); LS.Add(Format('List of %d series', [GetNbSeries])); LS.Add(''); LS.Add('No'+FIELD_SEPARATOR_TAB+'S.Dep'+FIELD_SEPARATOR_TAB+'Pt.Dep'+FIELD_SEPARATOR_TAB+'S.Arr'+FIELD_SEPARATOR_TAB+'Pt.Arr'+FIELD_SEPARATOR_TAB+ 'Serie name'+FIELD_SEPARATOR_TAB+'Nb points'+FIELD_SEPARATOR_TAB+'Length'+ FIELD_SEPARATOR_TAB + 'Estimated volume'); LS.Add(''); DevTotal:=0.00; NbPtsTotal:=0; VolumeTotal:=0.00; for i:=0 to GetNbSeries() - 1 do begin Ser := GetSerie(i); // calcul de la longueur, de la surface et du volume de la série D1:=0.00; VolumeSerie:=0.00; for n:=0 to Ser.NbVisees - 1 do begin V:=Ser.GetVisee(n); // les sections considérées pour les volumes // sont des ellipses (A = pi . a . b) case V.TypeVisee of tgDEFAULT, tgFOSSILE, tgVADOSE, tgENNOYABLE, tgSIPHON: // galeries naturelles begin; D1 := D1 + V.Longueur; // X += N -> X := X + N VolumeSerie := VolumeSerie + PI * (V.HZ+V.HN) * (V.LD + V.LG) * V.Longueur; end; else pass; end; end; VolumeTotal := VolumeTotal + VolumeSerie; DevTotal := DevTotal + D1; NbPtsTotal := NbPtsTotal + Ser.NbVisees - 1; LS.Add(Format(FMTLNSER, [Ser.NumeroDeSerie, Ser.NoSerieDep, Ser.NoPointDep, Ser.NoSerieArr, Ser.NoPointArr, Ser.NomSerie, Ser.NbVisees - 1, D1, VolumeSerie])); end; // for i:=0 to TableSeries.Count-1 LS.Add(''); LS.Add(Format('Total length: %.2f m (%d stations) - Estimated Volume: %.1f m3', [DevTotal, NbPtsTotal, VolumeTotal])); Result := 1; except pass; end; end; procedure TToporobotStructure2012.CheckerLesAntennes(); var Nb: Integer; begin Nb := GetNbAntennes(); AfficherMsgClass(self, 'CheckerLesAntennes(): %d visees rayonnantes',[Nb]); end; procedure TToporobotStructure2012.CheckerLesCodes(); var i, Nb: Integer; MyCode: TCode; ArrOfIdx: TArrayOfIntegers; function CheckerUnCode(const QC: TCode): boolean; begin result := false; pass; end; begin Nb := GetNbCodes(); AfficherMsgClass(self, 'CheckerLesCodes(): %d codes',[Nb]); if (0 = Nb) then begin MakeCode0(0, 'Code 0'); MakeCode0(1, 'Code 1 regenerated'); Exit; end; for i := 0 to Nb-1 do CheckerUnCode(GetCode(i)); if (HasDoublonsInCodes(ArrOfIdx)) then begin for i := 0 to ArrOfIdx.getNbElements() - 1 do begin MyCode := GetCodeByNumero(ArrOfIdx.getFrom(i)); AddMessageErreur(tmeCODES, TCriticiteMessaqeErreurGHTopo.cmeERROR, ArrOfIdx.getFrom(i), 'Doublon: ' + MyCode.toLineCSV('; ')); end; end; end; procedure TToporobotStructure2012.CheckerLesExpes(); var i, Nb: Integer; MyExpe: TExpe; ArrOfIdx: TArrayOfIntegers; function CheckerUneExpe(const QC: TExpe): boolean; begin result := false; pass; end; begin Nb := GetNbExpes(); AfficherMsgClass(self, 'CheckerLesExpes(): %d expés',[ Nb]); if (0 = Nb) then begin MakeExpe0(0, 'Expe 0'); MakeExpe0(1, 'Expe 1 regenerated'); Exit; end; for i := 0 to Nb-1 do CheckerUneExpe(GetExpe(i)); if (HasDoublonsInExpes(ArrOfIdx)) then begin for i := 0 to ArrOfIdx.getNbElements() - 1 do begin MyExpe := GetExpeByNumero(ArrOfIdx.getFrom(i)); AddMessageErreur(tmeEXPES, TCriticiteMessaqeErreurGHTopo.cmeERROR, ArrOfIdx.getFrom(i), 'Doublon: ' + MyExpe.toLineCSV('; ')); end; end; end; // vérifier si la visée en antenne possède une station de rattachement // utilise l'IDTerrain, la série et le point // Modifie la visée passée en paramètre (attribue les numeros de secteur et de reseau) function TToporobotStructure2012.HasStationForAntennaShot(var VA: TViseeAntenne): boolean; var SR: TObjSerie; VS: TUneVisee; i, j: Integer; begin Result := False; for i := 1 to GetNbSeries - 1 do begin SR := GetSerie(i); for j := 0 to SR.NbVisees - 1 do begin VS := SR.GetVisee(j); // test sur l'ID de série et station if ((VA.SerieDepart = SR.NumeroDeSerie) and (VA.PtDepart = j)) then begin VA.Secteur := VS.IDSecteur; VA.Reseau := SR.NumeroReseau; Result := True; Exit; end; end; // for j := 0 to SR.NbVisees - 1 do end; // for i := 1 to GetNbSeries - 1 do end; // extraire les antennes de la station NoSerie.NoStation // et l'envoie dans le tableau ArrAntennesFound // retourne le nombre d'antennes, ou 0 si aucunne antenne function TToporobotStructure2012.ExtractSplaysOfStation(const NoSerie: TNumeroSerie; const NoStation: Integer; out ArrAntennesFound: TArrayOfTViseeAntenne): integer; begin Result := FTableViseesAntenne.ExtractAntennesFromBasePoint(NoSerie, NoStation, False, ArrAntennesFound); end; // vérifie si le document GHTopo comporte des codes instruments étendus function TToporobotStructure2012.HasGHTopoCodesInstrumentsExtended(): boolean; var i, Nb : Integer; myCode : TCode; EWE : Boolean; miou : Int64; begin AfficherMsgClass(self, 'HasGHTopoCodesInstrumentsExtended()'); Result := false; Nb := GetNbCodes(); for i := 1 to Nb - 1 do begin myCode := GetCode(i); miou := Trunc(myCode.GradInc); // La forme miou in [v1, v2, ..., vn] ne fonctionne qu'avec 0 < vi < 256 //EWE := miou in [350, 359, 360, 361, 380, 390, 399, 400, 401]; EWE := (miou = 350) or (miou = 359) or (miou = 360) or (miou = 361) or (miou = 380) or (miou = 390) or (miou = 399) or (miou = 400) or (miou = 401); //*) EWE := Not EWE; AfficherMessageErreur('%d: %d - %.2f - %s', [i, myCode.IDCode, myCode.GradInc, BoolToStr(EWE, 'VRAI', 'FAUX')]); Result := Result OR EWE; end; AfficherMessage('Le document %s des codes instruments GHTopo', [BoolToStr(Result, 'CONTIENT', 'NE CONTIENT PAS')]); end; // supprimer les visées en antenne associées à une station, function TToporobotStructure2012.RemoveViseesRayonnantesAssocieesAStation(const qSer, qSt: integer): integer; var EWE: TViseeAntenne; Nb: Integer; B3: Boolean; begin Result := 0; AfficherMsgClass(self, 'RemoveViseeRayonnanteAssocieeAStation(): %d.%d', [qSer, qSt]); Nb := 0; while Nb < FTableViseesAntenne.Count - 1 do begin EWE := GetViseeAntenne(Nb); B3 := False; if (qSer > 0) then B3 := (EWE.SerieDepart = qSer) and (EWE.PtDepart = qSt); if (B3) then begin RemoveViseeAntenne(Nb); AfficherMessageErreur('Antenne retiree: %d.%d', [EWE.SerieDepart, EWE.PtDepart]); Result += 1; Nb := Nb - 1; end; Nb := Nb + 1; end; AfficherMessage('%d antennes supprimées', [Result]); end; // renommer les points d'origine des visées rayonnantes associées à une station function TToporobotStructure2012.MoveAntennesToAutreStation(const OldStation, NewStation: TToporobotIDStation; const DoDelete: boolean): integer; var MyAntenne: TViseeAntenne; Nb, i: Integer; begin result := 0; Nb := GetNbAntennes(); if (nb = 0) then exit; // mêmes stations ? --> [] if ((OldStation.aSerie = NewStation.aSerie) AND (OldStation.aStation = NewStation.aStation)) then Exit; for i := 0 to Nb - 1 do begin MyAntenne := GetViseeAntenne(i); if ((MyAntenne.SerieDepart = OldStation.aSerie) and (MyAntenne.PtDepart = OldStation.aStation)) then begin MyAntenne.SerieDepart := NewStation.aSerie; MyAntenne.PtDepart := NewStation.aStation; PutViseeAntenne(i, MyAntenne); Result += 1; end; end; end; function TToporobotStructure2012.MoveAntennesToAutreStation(const OldSerie: TNumeroSerie; const OldPoint: integer; const NewSerie: TNumeroSerie; const NewPoint: integer; const DoDelete: boolean): integer; var OldStation, NewStation: TToporobotIDStation; begin OldStation.aSerie := OldSerie; OldStation.aStation := OldPoint; NewStation.aSerie := NewSerie; NewStation.aStation := NewPoint; Result := MoveAntennesToAutreStation(OldStation, NewStation, DoDelete); end; // Recense les stations dotées d'un ID terrain compémentaire au numéro de série.station procedure TToporobotStructure2012.RecenserLesIDsTerrain(); var MyLabelTerrain: TToporobotIDStation; i, j, NbV : Integer; MySerie : TObjSerie; MyVisee : TUneVisee; WU : String; NbSts : Integer; begin AfficherMsgClass(self, 'RecenserLesIDsTerrain()'); FTableIDsTerrain.ClearListe(); // Cause fréquente d'erreurs: absence de la série 1 NbSts := 0; for i := 0 to GetNbSeries - 1 do begin MySerie := GetSerie(i); NbV := MySerie.NbVisees; NbSts := NbSts + NbV; if (NbV > 0) then begin for j := 0 to NbV - 1 do begin MyVisee := MySerie.GetVisee(j); WU := Trim(UpperCase(MyVisee.IDTerrainStation)); MyLabelTerrain.setFrom(MySerie.NumeroDeSerie, j , WU); if (WU <> '') then AddLabelTerrain(MyLabelTerrain); end; end; end; end; function TToporobotStructure2012.FindIdxIDTerrainByText(const Str: string): integer; var i, p, Nb: Integer; S: String; LT: TToporobotIDStation; begin Result := -1; S := UpperCase(Trim(Str)); Nb := FTableIDsTerrain.Count; if (Nb = 0) then Exit; for i := 0 to Nb - 1 do begin LT := GetLabelTerrain(i); p := Pos(S, UpperCase(LT.aIDTerrain)); if (p > 0) then Exit(i); end; end; //------------------------------------------------------------------------------ function TToporobotStructure2012.ReAttribuerViseesRayonnantesDeUneSerie(const SerieCourante: TObjSerie; const OldNumSerie: integer): integer; var i, Nb: Integer; begin Result := 0; Nb := SerieCourante.NbVisees; if (Nb = 0) then Exit; for i := 0 to Nb-1 do Result := Result + MoveAntennesToAutreStation(OldNumSerie, i, SerieCourante.NumeroDeSerie, i, false); end; // réattribuer les codes série.station d'une série modifiée function TToporobotStructure2012.UpdateSerPtExtremsSeriesRattachees(const OldNumSerie, NewNumSerie: integer): integer; var i: Integer; MySerie: TObjSerie; SerieAModifier: Boolean; MyEntree: TEntrance; begin Result := 0; AfficherMsgClass(self, 'UpdateSerPtExtremsSeriesRattachees(): Old: %d -> New: %d)', [OldNumSerie, NewNumSerie]); // entrées for i := 0 to GetNbEntrances() - 1 do begin MyEntree := GetEntrance(i); if (OldNumSerie = 1) then Continue; if (OldNumSerie = MyEntree.eRefSer) then begin AfficherMessage('Entree: %d - %s: Noeud %d.%d renamed to %.d.%d', [i, //MyEntree.eNumEntree, MyEntree.eNomEntree, MyEntree.eRefSer, MyEntree.eRefSt, NewNumSerie, MyEntree.eRefSt ]); MyEntree.eRefSer := NewNumSerie; PutEntrance(i, MyEntree); end; end; // séries for i := 1 to GetNbSeries - 1 do begin SerieAModifier := false; MySerie := GetSerie(i); if (OldNumSerie = MySerie.NoSerieDep) then begin AfficherMessage('Serie: %d - %s: Depart %d.%d renamed to %.d.%d', [MySerie.NumeroDeSerie, MySerie.NomSerie, MySerie.NoSerieDep, MySerie.NoPointDep, NewNumSerie, MySerie.NoPointDep ]); MySerie.SetNoSerieDep(NewNumSerie); SerieAModifier := True; end; if (OldNumSerie = MySerie.NoSerieArr) then begin AfficherMessage('Serie: %d - %s: Arrivee %d.%d renamed to %.d.%d', [MySerie.NumeroDeSerie, MySerie.NomSerie, MySerie.NoSerieArr, MySerie.NoPointArr, NewNumSerie, MySerie.NoPointArr ]); MySerie.SetNoSerieArr(NewNumSerie); SerieAModifier := True; end; if (SerieAModifier) then Result := Result + 1; end; end; //****************************************************************************** // Attrapper le premier IDx libre function TToporobotStructure2012.getMaxIdxExpe(): TNumeroExpe; var nb, i: Integer; EWE: TExpe; begin result := -1; nb := GetNbExpes(); for i := 1 to nb - 1 do begin EWE := GetExpe(i); Result := Max(Result, EWE.IDExpe); end; end; function TToporobotStructure2012.getMaxIdxCode(): TNumeroCode; var nb, i: Integer; EWE : TCode; begin result := -1; nb := getNbCodes(); for i := 1 to nb - 1 do begin EWE := getCode(i); Result := Max(Result, EWE.IDCode); end; end; // retourne le prochain index de série libre function TToporobotStructure2012.getMaxIdxSerie(): TNumeroSerie; var nb, i: Integer; EWE: TObjSerie; begin Result := -1; nb := self.GetNbSeries(); for i := 0 to nb -1 do begin EWE := GetSerie(i); Result := Max(Result, EWE.NumeroDeSerie); end; end; function TToporobotStructure2012.getMaxIdxReseau(): integer; begin result := GetNbReseaux(); end; function TToporobotStructure2012.getMaxIdxSecteur(): integer; begin result := GetNbSecteurs(); end; // remplacement d'index procedure TToporobotStructure2012.ReplaceIndexSeriesInEntrances(const OldIndex, NewIndex: TNumeroSerie); var Nb, i: Integer; EWE: TEntrance; begin AfficherMsgClass(self, 'ReplaceIndexSeriesInEntrances(): Old: %d -> New: %d', [OldIndex, NewIndex]); Nb := GetNbEntrances(); for i := 0 to Nb - 1 do begin EWE := GetEntrance(i); if (EWE.eRefSer = OldIndex) then begin EWE.eRefSer := NewIndex; PutEntrance(i, EWE); end; end; end; procedure TToporobotStructure2012.ReplaceIndexInStations(const OldIndex, NewIndex: integer; const ModeRemplacement: TModeRemplacementStations); var EWE: String; NbSeries, i, NbVisees, j: Integer; MySerie: TObjSerie; MyVisee: TUneVisee; begin EWE := ChooseString(Ord(ModeRemplacement), ['mrpSECTEURS', 'mrpCODES', 'mrpEXPES']); AfficherMsgClass(self, 'ReplaceIndexInStations(): Old: %d -> New: %d - %s', [OldIndex, NewIndex, EWE]); NbSeries := GetNbSeries(); for i := 0 to NbSeries - 1 do begin MySerie := GetSerie(i); NbVisees := MySerie.NbVisees; for j := 0 to NbVisees - 1 do begin MyVisee := MySerie.GetVisee(j); case ModeRemplacement of mrsSECTEURS: if (MyVisee.IDSecteur = OldIndex) then MyVisee.IDSecteur := NewIndex; mrsCODES : if (MyVisee.Code = OldIndex) then MyVisee.Code := NewIndex; mrsEXPES : if (MyVisee.Expe = OldIndex) then MyVisee.Expe := NewIndex; end; MySerie.PutVisee(j, MyVisee); end; end; end; procedure TToporobotStructure2012.ReplaceIdxCodes(const OldIndex, NewIndex: TNumeroCode); var Nb, i: Integer; EWE: TCode; begin AfficherMsgClass(self, 'ReplaceIdxCodes(): Old: %d -> New: %d', [OldIndex, NewIndex]); Nb := GetNbCodes(); for i := 0 to Nb - 1 do begin EWE := GetCode(i); if (EWE.IDCode = OldIndex) then begin EWE.IDCode := NewIndex; PutCode(i, EWE); end; end; end; procedure TToporobotStructure2012.ReplaceIdxExpes(const OldIndex, NewIndex: TNumeroExpe); var EWE: TExpe; Nb, i: Integer; begin AfficherMsgClass(self, 'ReplaceIdxExpes(): Old: %d -> New: %d', [OldIndex, NewIndex]); Nb := GetNbCodes(); for i := 0 to Nb - 1 do begin EWE := GetExpe(i); if (EWE.IDExpe = OldIndex) then begin EWE.IDExpe := NewIndex; PutExpe(i, EWE); end; end; end; procedure TToporobotStructure2012.ReplaceIdxSeries(const OldIndex, NewIndex: TNumeroSerie); var Nb, i: Integer; MySerie: TObjSerie; begin AfficherMsgClass(self, 'ReplaceIdxSeries(): Old: %d -> New: %d', [OldIndex, NewIndex]); Nb := GetNbSeries(); for i := 0 to Nb - 1 do begin MySerie := GetSerie(i); if (OldIndex = MySerie.NumeroDeSerie) then MySerie.SetNumeroSerie(NewIndex); if (OldIndex = MySerie.NoSerieDep) then MySerie.SetNoSerieDep(NewIndex); if (OldIndex = MySerie.NoSerieArr) then MySerie.SetNoSerieArr(NewIndex); end; end; // liste des messages d'erreur issues du checkup de la base function TToporobotStructure2012.GetNbMessagesErreur(): integer; begin if (not assigned(FListeMessagesErreur)) then exit(0); Result := FListeMessagesErreur.GetNbElements(); end; function TToporobotStructure2012.GetMessageErreur(const Idx: integer): TMessaqeErreurGHTopoCompiler; begin if (not Assigned(FListeMessagesErreur)) then Exit; if (0 = FListeMessagesErreur.GetNbElements()) then Result.setFrom(TTableExaminee.tmeALL_TABLES, 0, cmeNOTE, clGreen, 'No errors') else Result := FListeMessagesErreur.GetElement(Idx); end; procedure TToporobotStructure2012.AddMessageErreur(const M: TMessaqeErreurGHTopoCompiler); begin FListeMessagesErreur.AddElement(M); end; procedure TToporobotStructure2012.AddMessageErreur(const T: TTableExaminee; const QCriticite: TCriticiteMessaqeErreurGHTopo; const QIndex: Int64; const QMsg: string); var M: TMessaqeErreurGHTopoCompiler; begin M.setFrom(T, QIndex, QCriticite, ChooseColorInColorArray(Ord(QCriticite), [clGreen, clYellow, clFuchsia, clRed, clAqua]), QMsg); FListeMessagesErreur.AddElement(M); end; // Lecture/écriture au format XML // (futur format standard de GHTopo) //***************************************************************************** // Simplifier les visées en antenne d'une station procedure TToporobotStructure2012.ResetMarkersToDelete(); begin FTableViseesAntenne.ResetMarkersToDelete(); end; function TToporobotStructure2012.PurgerTableAntennes(): integer; begin Result := FTableViseesAntenne.Purger(); end; procedure TToporobotStructure2012.SimplifyAntennesOfStation(const QSerie: TNumeroSerie; const QPoint: integer; const Tolerance: double); var MySerie: TObjSerie; QIdx: integer; MyVisee: TUneVisee; MyCode: TCode; MyExpe: TExpe; begin if (GetSerieByNumeroSerie(QSerie, MySerie, QIdx)) then begin MyVisee := MySerie.GetVisee(QPoint); MyCode := GetCodeByNumero(MyVisee.Code); MyExpe := GetExpeByNumero(MyVisee.Expe); FTableViseesAntenne.SimplifyAntennesOfStation(QSerie, QPoint, MyCode, MyExpe, Tolerance); end; end; // Simplifier les visées d'une série procedure TToporobotStructure2012.SimplifyAntennesOfSerie(const QSerie: TObjSerie; const Tolerance: double); var NbStations, St: integer; QNumSerie: TNumeroSerie; begin QNumSerie := QSerie.NumeroDeSerie; AfficherMsgClass(self, 'SimplifyAntennesOfSerie(): Serie %d - Tolerance = %.2f m', [QNumSerie, Tolerance]); NbStations := QSerie.NbVisees; if (0 = NbStations) then Exit; for St := 1 to NbStations - 1 do SimplifyAntennesOfStation(QNumSerie, St, Tolerance); PurgerTableAntennes(); end; procedure TToporobotStructure2012.SimplifyAntennesOfAllReseau(const Tolerance: double); var NbSeries, i: Integer; MySerie: TObjSerie; EWE: String; begin NbSeries := GetNbSeries(); AfficherMsgClass(self, 'SimplifyAntennesOfAllReseau(): %d series - Tolerance = %.2f m', [NbSeries, Tolerance]); ResetMarkersToDelete(); for i := 1 to NbSeries - 1 do begin MySerie := GetSerie(i); EWE := Format('Série %d (%d stations)', [MySerie.NumeroDeSerie, MySerie.NbVisees]); if (Assigned(FProcDispProgression)) then FProcDispProgression(EWE, i, 0, NbSeries, 100); SimplifyAntennesOfSerie(MySerie, Tolerance); end; end; //============================================================================== // Calcul des LRUD d'une station, depuis une série //============================================================================== // Calcul des LRUD d'une station, depuis une série // TODO: A revoir function TToporobotStructure2012.CalcLRUD_AStationOfTheSerie(const MySerie: TObjSerie; const QNumeroStation: integer; const QDefL, QDefR, QDefU, QDefD: double): boolean; const DEMI_ECART_MAXIMAL_AZIMUT_DIRECTEUR = 10.00; QDEMI_LARGEUR_MINI = 0.50; QDEMI_HAUTEUR_MINI = 0.50; var MyCurrentVisee : TUneVisee; MyNearVisee : TUneVisee; MyCode : TCode; MyAntenne : TViseeAntenneFound; QArrAntennesFound: TArrayOfTViseeAntenne; i, n : Integer; Quadrant : double; AzimutMoyen, AzimutDirecteurGauche, AzimutDirecteurDroit: Double; LGMoyen, LDMoyen, HZMoyen, HNMoyen: double; TwoPIsurGradInclin, QInclin: double; dp, dz: double; b1, b2, b3, b4: Boolean; // Procédure interne : teste si une antenne est proche de l'azimut directeur // et met à jour LG ou LD suivant le côté (* procedure _NearToAz(const AD: double; const IsLeft: Boolean); var c, s: double; begin if (IsNearToAzimut(MyCode.GradAz, MyAntenne.VA.Azimut, AD, DEMI_ECART_MAXIMAL_AZIMUT_DIRECTEUR)) then begin QInclin := MyAntenne.VA.Pente * TwoPIsurGradInclin; SinCos(QInclin, s, c); dp := MyAntenne.VA.Longueur * c; dz := abs(MyAntenne.VA.Longueur * s); LGMoyen := IfThen(IsLeft, Max(LGMoyen, dp), Max(LDMoyen, dp)); HZMoyen := Max(HZMoyen, dz); HNMoyen := Min(HNMoyen, dz); end; end; //*) begin Result := false; MyCurrentVisee := MySerie.GetVisee(QNumeroStation); MyCode := GetCodeByNumero(MyCurrentVisee.Code); // D'abord, on met par défaut MyCurrentVisee.LG := QDefL; MyCurrentVisee.LD := QDefR; MyCurrentVisee.HZ := QDefU; MyCurrentVisee.HN := QDefD; // extraction des visées radiantes n := ExtractSplaysOfStation(MySerie.NumeroDeSerie, QNumeroStation, QArrAntennesFound); for i := 0 to Min(n-1, 3) do begin case i of 0: MyCurrentVisee.LG := QArrAntennesFound.getElement(i).VA.Longueur; 1: MyCurrentVisee.LD := QArrAntennesFound.getElement(i).VA.Longueur; 2: MyCurrentVisee.HZ := QArrAntennesFound.getElement(i).VA.Longueur; 3: MyCurrentVisee.HN := QArrAntennesFound.getElement(i).VA.Longueur; end; end; MySerie.PutVisee(QNumeroStation, MyCurrentVisee); Exit(True); // ce qui suit est neutralisé mais à conserver (* Quadrant := 90.00; // calcul du quadrant case round(MyCode.GradAz) of 359, 360: Quadrant := 90.00; // visées directes en degrés 399, 400: Quadrant := 100.00; // visées directes en grades 349, 350: Quadrant := -90.00; // visées inverses en degrés 389, 390: Quadrant := -100.00; // visées inverses en grades end; // calcul de l'azimut directeur if ((QNumeroStation = 1) OR (QNumeroStation = (MySerie.NbVisees - 1))) then begin AzimutMoyen := MyCurrentVisee.Azimut; // station d'extrémité end else begin MyNearVisee := MySerie.GetVisee(QNumeroStation + 1); AzimutMoyen := CalcAzimutMoyen(MyCode.GradAz, [MyCurrentVisee.Azimut, MyNearVisee.Azimut]); end; AzimutDirecteurGauche := AzimutMoyen - Quadrant; AzimutDirecteurDroit := AzimutMoyen + Quadrant; // Init des valeurs LRUD LGMoyen := -1E8; LDMoyen := -1E8; HZMoyen := -1E8; HNMoyen := 1E8; // conversion grades -> radians si besoin case round(MyCode.GradInc) of 359, 360, 361: TwoPIsurGradInclin := 2 * PI / 360.00; 399, 400, 401: TwoPIsurGradInclin := 2 * PI / 400.00; else TwoPIsurGradInclin := 2 * PI / 360.00; end; // boucle sur les antennes for i := 0 to n - 1 do begin MyAntenne := QArrAntennesFound.FArray[i]; _NearToAz(AzimutDirecteurGauche, True); // gauche _NearToAz(AzimutDirecteurDroit, False); // droite end; // mise à jour seulement si valeurs plausibles b1 := InRange(LGMoyen, 0, SEUIL_LONGUEUR_MAXI_TOPOROBOT); b2 := InRange(LDMoyen, 0, SEUIL_LONGUEUR_MAXI_TOPOROBOT); b3 := InRange(HZMoyen, 0, SEUIL_LONGUEUR_MAXI_TOPOROBOT); b4 := InRange(HNMoyen, 0, SEUIL_LONGUEUR_MAXI_TOPOROBOT); if (b1) then MyCurrentVisee.LG := LGMoyen; if (b2) then MyCurrentVisee.LD := LDMoyen; if (b3) then MyCurrentVisee.HZ := HZMoyen; if (b4) then MyCurrentVisee.HN := HNMoyen; // Valeurs mini pour les volumes 3D MyCurrentVisee.LG := Max(QDEMI_LARGEUR_MINI, MyCurrentVisee.LG); MyCurrentVisee.LD := Max(QDEMI_LARGEUR_MINI, MyCurrentVisee.LD); MyCurrentVisee.HZ := Max(QDEMI_HAUTEUR_MINI, MyCurrentVisee.HZ); MyCurrentVisee.HN := Max(QDEMI_HAUTEUR_MINI, MyCurrentVisee.HN); // et on met à jour MySerie.PutVisee(QNumeroStation, MyCurrentVisee); Result := (b1 or b2 or b3 or b4); // === TRACE DEBUG === if Result then begin AfficherMessage( 'Station %d - LRUD recalculés: LG=%.2f / LD=%.2f / HZ=%.2f / HN=%.2f', [QNumeroStation, MyCurrentVisee.LG, MyCurrentVisee.LD, MyCurrentVisee.HZ, MyCurrentVisee.HN] ); end; //*) end; // Calcul des LRUD de toutes les stations d'une série function TToporobotStructure2012.CalcLRUD_AllStationsOfTheSerie(const MySerie: TObjSerie; const QDefL, QDefR, QDefU, QDefD: double): boolean; var n, i: Integer; begin Result := false; try //AfficherMsgClass(self, 'CalcLRUD_AllStationsOfTheSerie(): Serie %d', [MySerie.NumeroDeSerie]); n := MySerie.NbVisees; if (n > 1) then begin for i := 1 to n - 1 do CalcLRUD_AStationOfTheSerie(MySerie, i, QDefL, QDefR, QDefU, QDefD); end; result := True; except on E: Exception do begin AfficherMsgErrClass(self, '%s: %d: %s', [{$I %FILE%}, {$I %LINE%}, E.Message]); end; end; end; // Calcul ponctuel des LRUD d'une station // (ne pas utiliser pour calculer toutes les stations d'une série; utiliser CalcLRUD_AllStationsOfTheSerie() pour celà) function TToporobotStructure2012.CalcLRUD_AStationOfSerieByNumSerSt(const QNumeroSerie: TNumeroSerie; const QNumeroStation: integer; const QDefL, QDefR, QDefU, QDefD: double): boolean; var MySerie : TObjSerie; QIdxSerie: integer; begin Result := false; //AfficherMessage('%s.CalcLRUDOfStationFromRadiantShots: Serie %d, Station: %d', [ClassName, QNumeroSerie, QNumeroStation])); if (not GetSerieByNumeroSerie(QNumeroSerie, MySerie, QIdxSerie)) then Exit(false); Result := CalcLRUD_AStationOfTheSerie(MySerie, QNumeroStation, QDefL, QDefR, QDefU, QDefD); end; //****************************************************************************** function TToporobotStructure2012.HasDoublonsInNumsSeries(out ArrOfIdx: TArrayOfIntegers): boolean; var MySerie: TObjSerie; Nb, i: Integer; LS: TStringList; A0, A1: String; begin result := false; AfficherMsgErrClass(self, 'HasDoublonsInSeries(): %d series', [GetNbSeries()]); ArrOfIdx.ReDim(0); LS := TStringList.Create; try LS.Clear; for i := 0 to self.GetNbSeries() - 1 do LS.Add(format('%d', [self.GetSerie(i).NumeroDeSerie])); LS.Sort; for i := 1 to LS.Count - 1 do begin A0 := LS[i-1]; A1 := LS[i]; //AfficherMessageErreur(A1 + '-' + A0); if (A0 = A1) then begin AfficherMessageErreur(A1); ArrOfIdx.appendFrom(StrToIntDef(A1, 0)); end; end; AfficherMessageErreur('Doublons: %d', [ArrOfIdx.getNbElements()]); finally FreeandNil(LS); end; Result := (ArrOfIdx.getNbElements() > 1); if (result) then begin AfficherMessageErreur('La table contient %d doublons', [ArrOfIdx.getNbElements()]); for i := 0 to ArrOfIdx.getNbElements() - 1 do begin AfficherMessageErreur(' -- %d: %d', [i, ArrOfIdx.getFrom(i)]); end; end; end; // détection de doublons dans les numéros de série, expés et codes // retourne l'index interne de l'objet, ou 0 si aucune erreur function TToporobotStructure2012.NumSerieAlreadyAttributed(const NS: TNumeroSerie; out QInternalIdx: integer): boolean; var MySerie: TObjSerie; Nb, i, NbOccur: Integer; begin QInternalIdx := 0; result := false; NbOccur := 0; Nb := GetNbSeries(); for i := 0 to Nb - 1 do begin MySerie := GetSerie(i); if (NS = MySerie.NumeroDeSerie) then begin NbOccur := NbOccur + 1; QInternalIdx := i; end; end; Result := (NbOccur > 1); // et non NbOccur > 0 !!! : il y a soit 0 occurrence (série inexistante), soit 1 (série unique), soit 2 ou plus (doublons) end; // Fonctions inutiles ou invalides sous Android et désactivées // ouverture d'un fichier XML (gtx) // function TToporobotStructure2012.LoadFromXML(const FichierXML: TStringDirectoryFilename): integer; // procedure TToporobotStructure2012.SaveToXML(const FichierXML: TStringDirectoryFilename); {$INCLUDE FuncLoadSaveFichierXML.inc} // charger depuis fichier Tab ou XTB // /!\ Ne pas faire les conversions en UTF8 ici: // Les directives INCLUDE ne fonctionnent pas pour les séries // function TToporobotStructure2012.LoadFromXTB(const FichierTAB: TStringDirectoryFilename): integer; // procedure TToporobotStructure2012.SaveToXTB(const FichierTAB: TStringDirectoryFilename; const ModeSaveTAB: TModeSaveTAB; const TextFileFormat: TTextFileFormat); {$INCLUDE FuncLoadSaveFichierTab.inc} // Statut: Opérationnel mais les commentaires des séries et stations sont ignorés // Le format .Text est deprecated et est surtout destiné à PocketTopo // function TToporobotStructure2012.LoadFichierText(const FichierText: TStringDirectoryFilename): integer; deprecated; // procedure TToporobotStructure2012.ExporterVersToporobotTEXT(const QFileName: TStringDirectoryFilename; // const LongueurMaxAntenne: double; // const DoExportAntennaShots: boolean); // Inutilisé // deprecated 'Le format TOPOROBOT Text est peu pratique'; {$INCLUDE FuncLoadSaveFichierTEXT.inc} //// charger un fichier PocketTopo TXT // function TToporobotStructure2012.LoadFromPocketTopoTXT(const FichierTXT: TStringDirectoryFilename): integer; deprecated; {$INCLUDE FuncImportPocketTopoTxt.inc} //// charger un fichier SexyTopo JSON // function TToporobotStructure2012.LoadFromSexyTopoJSON(const FichierTXT: TStringDirectoryFilename): integer; deprecated; {$INCLUDE FuncImportSexyTopo.inc} //// Sauvegarder un fichier SURVEX // procedure TToporobotStructure2012.SaveToSVX(const FichierSVX: TStringDirectoryFilename); {$INCLUDE FuncExportSVX.inc} //****************************************************************************** procedure TToporobotStructure2012.ExportListeEntreesCSV(const ToClipBoard: boolean; const FileName: TStringDirectoryFilename); var LS: TStringList; MyClipboard: TClipboard; i, Nb: Integer; myEntrance: TEntrance; begin Nb := GetNbEntrances(); AfficherMsgClass(self, 'ExportListeEntreesCSV(): %d items', [Nb]); if (Nb = 0) then exit; LS := TStringList.Create; try LS.Clear; LS.Add('No' + FIELD_SEPARATOR_TAB + 'Nom' + FIELD_SEPARATOR_TAB + 'X' + FIELD_SEPARATOR_TAB + 'Y' + FIELD_SEPARATOR_TAB + 'Z' + FIELD_SEPARATOR_TAB + 'Serie' + FIELD_SEPARATOR_TAB + 'Point' + FIELD_SEPARATOR_TAB + 'Observ'); for i := 0 to Nb - 1 do begin myEntrance := GetEntrance(i); LS.Add(myEntrance.toLineCSV(i)); end; if (ToClipBoard) then begin MyClipboard := TClipboard.Create(ctClipBoard); try MyClipboard.AsText := LS.Text; finally FreeandNil(MyClipboard); end; end else begin LS.SaveToFile(FileName); end; LS.Clear; finally FreeAndNil(LS); end; end; procedure TToporobotStructure2012.ExportListeReseauxCSV(const ToClipBoard: boolean; const FileName: TStringDirectoryFilename); var LS: TStringList; i, Nb: Integer; myReseau: TReseau; MyClipboard: TClipboard; begin Nb := GetNbReseaux; AfficherMsgClass(self, 'ExportListeReseauxCSV: %d items', [Nb]); if (Nb = 0) then exit; LS := TStringList.Create; try LS.Clear; LS.Add('No' + FIELD_SEPARATOR_TAB + 'Type' + FIELD_SEPARATOR_TAB + 'Couleur' + FIELD_SEPARATOR_TAB + 'Nom' + FIELD_SEPARATOR_TAB + 'Observ'); for i := 0 to Nb -1 do begin myReseau := GetReseau(i); LS.Add(myReseau.toLineXTB(i)); end; if (ToClipBoard) then begin MyClipboard := TClipboard.Create(ctClipBoard); try MyClipboard.AsText := LS.Text; finally FreeandNil(MyClipboard); end; end else begin LS.SaveToFile(FileName); end; LS.Clear; finally FreeandNil(LS); end; end; procedure TToporobotStructure2012.ExportListeSecteursCSV(const ToClipBoard: boolean; const FileName: TStringDirectoryFilename); var LS: TStringList; MyClipboard: TClipboard; i, Nb: Integer; mySecteur: TSecteur; begin Nb := GetNbSecteurs; AfficherMsgClass(self, 'ExportListeSecteursCSV(): %d items', [Nb]); if (Nb = 0) then exit; LS := TStringList.Create; try LS.Clear; LS.Add('No' + FIELD_SEPARATOR_TAB + 'Type' + FIELD_SEPARATOR_TAB + 'Couleur' + FIELD_SEPARATOR_TAB + 'Nom'); for i := 0 to Nb -1 do begin mySecteur := GetSecteur(i); LS.Add(mySecteur.toLineCSV(i)); end; if (ToClipBoard) then begin MyClipboard := TClipboard.Create(ctClipBoard); try MyClipboard.AsText := LS.Text; finally FreeandNil(MyClipboard); end; end else begin LS.SaveToFile(FileName); end; LS.Clear; finally FreeandNil(LS); end; end; procedure TToporobotStructure2012.ExportListeCodesCSV(const ToClipBoard: boolean; const FileName: TStringDirectoryFilename); var i, Nb: Integer; myCode: TCode; MyClipboard: TClipboard; LS: TStringList; begin Nb := GetNbCodes(); AfficherMsgClass(self, 'ExportListeCodesCSV(): %d items', [Nb]); if (Nb = 0) then Exit; LS := TStringList.Create; try LS.Clear; LS.Add(FileName); LS.Add('No' + FIELD_SEPARATOR_TAB + 'UniteBoussole' + FIELD_SEPARATOR_TAB + 'CorrectionAzimut' + FIELD_SEPARATOR_TAB + 'UniteClino' + FIELD_SEPARATOR_TAB + 'CorrectionPente' + FIELD_SEPARATOR_TAB + 'Observ'); for i := 0 to Nb -1 do begin myCode := GetCode(i); LS.Add(myCode.toLineCSV()); end; if (ToClipBoard) then begin MyClipboard := TClipboard.Create(ctClipBoard); try MyClipboard.AsText := LS.Text; finally FreeandNil(MyClipboard); end; end else begin LS.SaveToFile(FileName); end; LS.Clear; finally FreeandNil(LS); end; end; procedure TToporobotStructure2012.ExportListeExpesCSV(const ToClipBoard: boolean; const FileName: TStringDirectoryFilename); var i, Nb: Integer; myExpe: TExpe; LS: TStringList; MyClipboard: TClipboard; begin Nb := GetNbExpes; AfficherMsgClass(self, 'ExportListeExpesCSV: %d items', [Nb]); if (Nb = 0) then exit; LS := TStringList.Create; try LS.Clear; LS.Add('No ' + FIELD_SEPARATOR_TAB + 'Couleur ' + FIELD_SEPARATOR_TAB + 'Date' + FIELD_SEPARATOR_TAB + 'Equipe' + FIELD_SEPARATOR_TAB + 'Observ'); for i := 0 to Nb -1 do begin myExpe := GetExpe(i); LS.Add(myExpe.toLineCSV()); end; if (ToClipBoard) then begin MyClipboard := TClipboard.Create(ctClipBoard); try MyClipboard.AsText := LS.Text; finally FreeandNil(MyClipboard); end; end else begin LS.SaveToFile(FileName); end; LS.Clear; finally FreeandNil(LS); end; end; // Calcul d'incertitude pour la station ssss.pppp // Ne pas le mettre dans le TObjSerie étant donné que les codes sont utilisés // TODO: A revoir function TToporobotStructure2012.CalculIncertitude(const QNumSerie: TNumeroSerie; const QNumPt: TNumeroStation; out edx, edy, edz: double): boolean; var QNbSts, i, QInternalIdx: Integer; QIncertitudeRelativeLongueurs : double; QIncertitudeRelativeAzimuts : double; QIncertitudeRelativePentes : double; dr , rdtheta, rdphi, rh : double; VV: TUneVisee; E_dxi, E_dyi, E_dzi , SA, CA, CP, SP: double; MySerie: TObjSerie; begin result := false; if (not GetSerieByNumeroSerie(QNumSerie, MySerie, QInternalIdx)) then exit; try QNbSts := IIF(QNumPt = -1, MySerie.NbVisees, QNumPt); AfficherMsgErrClass(MySerie, 'CalculIncertitude(): %d stations', [QNbSts]); // valeurs exemple provisoires QIncertitudeRelativeLongueurs := 1/1000; QIncertitudeRelativeAzimuts := degtorad(1/UNITE_ANGULAIRE_PAR_DEFAUT); QIncertitudeRelativePentes := gradtorad(1/400.00); edx := 0.00; edy := 0.00; edz := 0.00; for i := 1 to QNbSts - 1 do begin VV := MySerie.GetVisee(i); dr := VV.Longueur * QIncertitudeRelativeLongueurs; rdtheta := VV.Longueur * QIncertitudeRelativeAzimuts; rdphi := VV.Longueur * QIncertitudeRelativePentes; SinCos(DegToRad(VV.Azimut), SA, CA); SinCos(DegToRad(VV.Pente), SP, CP); rh := dr * rdphi * CP; E_dxi := rh * rdtheta * SA ** 2; E_dyi := rh * rdtheta * CA ** 2; E_dzi := dr * rdphi * SP ** 2; edx += E_dxi; edy += E_dyi; edz += E_dzi; end; edx := sqrt(edx); edy := sqrt(edy); edz := sqrt(edz); // TODO: A revoir result := true; except on E: Exception do begin AfficherMsgErrClass(self, '%s: %d: %s', [{$I %FILE%}, {$I %LINE%}, E.Message]); end; end; end; // Recalcul des déclinaisons magnétiques procedure TToporobotStructure2012.RecalculerDeclinaisonsMagnetiquesExpes(); var CalculateurDeclimag : TSAGeoMag; i, NbE: Integer; EX: TExpe; Lat, Lon: double; PTI, PTO: TPoint2Df; MyCentroide: TPoint3Df; EWE: String; begin AfficherMsgClass(self, 'RecalculerDeclinaisonsMagnetiquesExpes()'); CalculateurDeclimag := TSAGeoMag.Create; try // Etape 0: Démarrage du calculateur de déclinaison if (not CalculateurDeclimag.Initialiser()) then begin AfficherMessage('Calculateur de déclinaisons magnétiques inopérant - Arrêt'); exit; end; // calcul du centroïde des entrées MyCentroide := CalcCentroideEntrees(); // qu'on convertit en WGS84 PTI.setFrom(MyCentroide.X, MyCentroide.Y); PTO.Empty(); // si la conversion réussit: Etape 2: Calcul des déclinaisons pour les expés if (ConversionCoupleCoordonneesIsoleesEPSG(FSystemeDeCoordonneesCodeEPSG.CodeEPSG, CODE_EPSG_WGS84, PTI, PTO)) then begin Lat := PTO.X; Lon := PTO.Y; AfficherMessageErreur('-- X = %.2f, Y = %.2f, Z = %.f - Lat = %.8f, Lon = %.8f', [MyCentroide.X, MyCentroide.Y, MyCentroide.Z, Lat, Lon]); AfficherMessage(''); NbE := GetNbExpes(); AfficherMessage('-- Declinaisons pour les %d expes', [NbE]); for i := 1 to NbE - 1 do begin EX := GetExpe(i); EX.ModeDecl := cdmAUTOMATIQUE; // on force en automatique // DONE: Vérifier le signe des déclinaisons dans CalculerDeclinaison(); // Les déclinaisons dont toujours en degrés EX.DeclinaisonInDegrees := CalculateurDeclimag.CalculerDeclinaison(lat, lon, MyCentroide.Z, EX.DateExpe); AfficherMessageErreur('Expe: %d: %s: %.8f', [EX.IDExpe, DatePascalToDateSQL(EX.DateExpe), EX.DeclinaisonInDegrees]); PutExpe(i, EX); // et on met à jour la table end; end; CalculateurDeclimag.Finaliser(); finally FreeAndNil(CalculateurDeclimag); end; end; procedure TToporobotStructure2012.CheckerAltimetrieEntrancesByMNT(const FM: TMaillage; const DoAdjustAtMNT: boolean; const DeltaZMax: double); const QFMT_ERR_MSG = '%d; %d.%d; %s; %s; %s; %s; %s; %s;'; var i, Nb: Integer; AltitudeOfMNT, DeltaZ: double; MyEntrance: TEntrance; begin Nb := self.GetNbEntrances(); AltitudeOfMNT := -666.00; AfficherMsgClass(self, 'CheckerAltimetrieEntrancesByMNT(): %d entrances, MNT %svalide', [Nb, BooltoStr(FM.IsValid, '', 'in')]); if (not FM.IsValid) then exit; AfficherMessageErreur('Extraction des altitudes pour les %d entrées', [Nb]); for i := 0 to Nb - 1 do begin MyEntrance := self.GetEntrance(i); FM.CalcAltitudeMaillageAtPoint(MyEntrance.ePosition.X, MyEntrance.ePosition.Y, AltitudeOfMNT); DeltaZ := MyEntrance.ePosition.Z - AltitudeOfMNT; AfficherMessageErreur(QFMT_ERR_MSG, [i, MyEntrance.eRefSer, MyEntrance.eRefSt, MyEntrance.eNomEntree, FormatterNombreOOo(MyEntrance.ePosition.X), FormatterNombreOOo(MyEntrance.ePosition.Y), FormatterNombreOOo(MyEntrance.ePosition.Z), FormatterNombreOOo(AltitudeOfMNT), FormatterNombreOOo(DeltaZ)]); end; end; function TToporobotStructure2012.TryToAddViseeAtDatabase(constref StFrom, StTo: TToporobotIDStation; constref V: TUneVisee): boolean; var SR, MySerie: TObjSerie; QInternalIdxSerie, NV: integer; EWE: String; begin result := false; EWE := ''; EWE := format(' *** TryToAddViseeAtDatabase : Point candidat: %s : ', [StTo.ToString()]); if (self.GetSerieByNumeroSerie(StTo.aSerie, SR, QInternalIdxSerie)) then begin try NV := SR.NbVisees - 1; EWE += format(' -- Série trouvée: %d - %s - Dernier point: %d', [SR.NumeroDeSerie, SR.NomSerie, NV]); if (StTo.aStation > NV) then SR.AddVisee(V); SR.SetSeriePtArr(SR.NumeroDeSerie, SR.NbVisees - 1); Result := true; except on E: Exception do begin AfficherMsgErrClass(self, '%s: %d: %s', [{$I %FILE%}, {$I %LINE%}, E.Message]); end; end; end else begin try EWE += format(' -- Nouvelle série à créer avec le numéro %d', [StTo.aSerie]); MySerie := TObjSerie.Create; MySerie.ClearStations(); MySerie.SetNumeroSerie(StTo.aSerie); MySerie.SetSeriePtDep(StFrom.aSerie, StFrom.aStation); MySerie.SetNomObsSerie(format('Nouvelle série en %s', [StFrom.ToString()]), ''); MySerie.SetChanceObstacle(0, 0); MySerie.SetNumeroEntranceReseau(FCurrentNumeroEntrance, FCurrentNumeroReseau); MySerie.SetRaideur(1.00); MySerie.AddVisee(FCurrentNumeroSecteur, FCurrentNumeroCode, FCurrentNumeroExpe, tgDEFAULT, 0.001, 45, 0.0, 0.0,0.0,0.0,0.0,'', 'Visée 0', Now(), 0.00, 0.00); MySerie.AddVisee(V); MySerie.SetSeriePtArr(MySerie.NumeroDeSerie, MySerie.NbVisees - 1); Self.AddSerie(MySerie); result := true; except on E: Exception do begin AfficherMsgErrClass(self, '%s: %d: %s', [{$I %FILE%}, {$I %LINE%}, E.Message]); end; end; end; //AfficherMessageErreur(EWE); end; function TToporobotStructure2012.SearchIntoDatabase(const FindWhat: string; out Qresults: TSearchResultsInTopoData; const P: TCallbackOnFound): boolean; var NbElements, i, v: integer; QReseau: TReseau; QSecteur: TSecteur; QCode: TCode; QExpe: TExpe; MySerie: TObjSerie; QSplay: TViseeAntenne; FW, WUS: String; QEntrance: TEntrance; MyVisee: TUneVisee; QR: TDocTopoSearchResult; function Toto(const T: TTableExaminee; out Nb: integer): boolean; var WU: String; begin result := false; Nb := -1; WU := ChooseString(ord(T), ['ENTREES', 'RESEAUX', 'SECTEURS', 'CODES', 'EXPES', 'SERIES', 'SPLAYS', '---']); case T of tmeENTRANCES: Nb:= GetNbEntrances(); tmeRESEAUX : Nb:= GetNbReseaux(); tmeSECTEURS : Nb:= GetNbSecteurs(); tmeCODES : Nb:= GetNbCodes(); tmeEXPES : Nb:= GetNbExpes(); tmeSERIES : Nb:= GetNbSeries(); tmeSPLAYS : Nb:= GetNbAntennes(); tmeSHOTS : Nb := -1; tmeALL_TABLES: Nb := -1; end; AfficherMessageErreur('--> Scanning table: %s (%d items)', [WU, Nb]); Result := (Nb > 0); end; function SBOUB(const T: TTableExaminee; const QIdx, QSubIdx: integer; const L:string): boolean; var ARR: TGHStringArrayExt; s: Integer; RR: TDocTopoSearchResult; begin s := -1; try ARR.SplitFrom(L, FIELD_SEPARATOR_TAB); for s := 0 to ARR.getNbNotNullValues() -1 do begin if (ContainsSubStr(UpperCase(ARR.getString(s)), FW, false)) then begin RR.Table := T; RR.IndexElement := QIdx; RR.IndexSubElement := QSubIdx; RR.IndexColumn := s; RR.Fields := ARR.toStringArray(); RR.RowContent := L; QResults.Append(RR); if (assigned(P)) then P(RR, Qresults.getNbElements()); end; end; Result := (Qresults.getNbElements() > NB_MAX_SEARCH_RESULTS); except on E: exception do AfficherMessageErreur(E.Message + ' - ' + L); end; end; function SGUEG(const T: TTableExaminee; const QIdx, QSubIdx: integer; const L:string): boolean; var ARR: TGHStringArrayExt; RR: TDocTopoSearchResult; begin try ARR.Redim(1); ARR.setString(0, L); RR.Table := T; RR.IndexElement := QIdx; RR.IndexSubElement := QSubIdx; RR.IndexColumn := 3; RR.Fields := ARR.toStringArray(); RR.RowContent := L; QResults.Append(RR); if (assigned(P)) then P(RR, Qresults.getNbElements()); Result := (Qresults.getNbElements() > NB_MAX_SEARCH_RESULTS); except on E: exception do AfficherMessageErreur(E.Message + ' - ' + L); end; end; function FindSerPtsInSeries(): boolean; const FMT_EWE = '%s , %s at station %s'; var Nb, s, j: Integer; BP: TToporobotIDStation; ASerie: TObjSerie; AShot: TUneVisee; begin result := false; Nb := GetNbSeries(); BP.setFrom(FindWhat); if (BP.aSerie = -1) then exit; for s := 0 to Nb-1 do begin ASerie := getSerie(s); if (BP.EqualTo(ASerie.StationDepart)) then begin result := True; if (SBOUB(tmeSERIES, ASerie.NumeroDeSerie, 0, format(FMT_EWE, [ASerie.NomSerie, 'Starting', BP.ToString()]))) then Break; end; if (BP.EqualTo(ASerie.StationArrivee)) then begin result := True; if (SBOUB(tmeSERIES, ASerie.NumeroDeSerie, 0, format(FMT_EWE, [ASerie.NomSerie, 'Ending', BP.ToString()]))) then Break; end; for j := 0 to ASerie.NbVisees - 1 do begin AShot := ASerie.GetVisee(j); if (BP.EqualTo(ASerie.NumeroDeSerie, j)) then begin result := True; if (SGUEG(tmeSHOTS, ASerie.NumeroDeSerie, j, AShot.toLineCSV(j))) then Break; end; end; end; end; begin AfficherMsgClass(self, 'SearchIntoDatabase(): %s', [FindWhat]); FW := UpperCase(FindWhat); Qresults.Redim(0); if (Toto(tmeENTRANCES, NbElements)) then begin for i := 0 to NbElements-1 do begin QEntrance := self.GetEntrance(i); if (SBOUB(tmeENTRANCES, i, -1, QEntrance.toLineCSV(i))) then Break; end; end; if (Toto(tmeRESEAUX, NbElements)) then begin for i := 0 to NbElements-1 do begin QReseau := self.GetReseau(i); if (SBOUB(tmeRESEAUX, i, -1, QReseau.toLineCSV(i))) then Break; end; end; if (Toto(tmeSECTEURS, NbElements)) then begin for i := 0 to NbElements-1 do begin QSecteur := self.GetSecteur(i); if (SBOUB(tmeSECTEURS, i, -1, QSecteur.toLineCSV(i))) then Break;; end; end; if (Toto(tmeCODES, NbElements)) then begin for i := 0 to NbElements-1 do begin QCode := self.GetCode(i); if (SBOUB(tmeCODES, QCode.IDCode, -1, QCode.toLineCSV())) then Break;; end; end; if (Toto(tmeEXPES, NbElements)) then begin for i := 0 to NbElements-1 do begin QExpe := self.GetExpe(i); if (SBOUB(tmeEXPES, QExpe.IDExpe, -1, QExpe.toLineCSV())) then Break;; end; end; if (not FindSerPtsInSeries()) then begin if (Toto(tmeSERIES, NbElements)) then begin for i := 0 to NbElements-1 do begin MySerie := self.GetSerie(i); if (SBOUB(tmeSERIES, MySerie.NumeroDeSerie, -1, MySerie.toLineHeaderCSV())) then Break;; for v := 0 to MySerie.NbVisees - 1 do begin MyVisee := MySerie.GetVisee(v); if (SBOUB(tmeSERIES, MySerie.NumeroDeSerie, v, MyVisee.toLineCSV(v))) then Break; end; end; end; if (Toto(tmeSPLAYS, NbElements)) then begin for i := 0 to NbElements-1 do begin QSplay := self.GetViseeAntenne(i); if (SBOUB(tmeSPLAYS, i, -1, QSplay.toLineCSV(i))) then Break;; end; end; end; AfficherMessageErreur('Found %d matches ', [Qresults.getNbElements()]); if (Qresults.getNbElements() > 0) then begin for i := 0 to Qresults.getNbElements() - 1 do begin QR := QResults.getElement(i); WUS := ChooseString(ord(QR.Table), ['ENTREES', 'RESEAUX', 'SECTEURS', 'CODES', 'EXPES', 'SERIES', 'SPLAYS', '---']); AfficherMessageErreur('Table %s: %d %d %d - %s', [WUS, QR.IndexElement, QR.IndexSubElement, QR.IndexColumn, QR.RowContent]); end; end; end; procedure TToporobotStructure2012.ExportListePOIToCSV(const ToClipBoard: boolean; const FileName: TStringDirectoryFilename); var LS: TStringList; MyClipboard: TClipboard; Nb, i: Integer; MyPOI: TGHTopoPointOfInterest; begin Nb := GetNbPointsOfInterests(); AfficherMsgClass(self, 'ExportListePOIToCSV(): %d items', [Nb]); if (Nb = 0) then exit; LS := TStringList.Create; try LS.Clear; LS.Add('No ' + FIELD_SEPARATOR_TAB + 'Serie' + FIELD_SEPARATOR_TAB + 'Station' + FIELD_SEPARATOR_TAB + 'Couleur' + FIELD_SEPARATOR_TAB + 'IDTerrain' + FIELD_SEPARATOR_TAB + 'Description'); for i := 0 to Nb -1 do begin MyPOI := GetPointOfInterest(i); LS.Add(MyPOI.toLineCSV(i)); end; if (ToClipBoard) then begin MyClipboard := TClipboard.Create(ctClipBoard); try MyClipboard.AsText := LS.Text; finally FreeandNil(MyClipboard); end; end else begin LS.SaveToFile(FileName); end; LS.Clear; finally FreeandNil(LS); end; end; procedure TToporobotStructure2012.ExportListeErreursToCSV(const ToClipBoard: boolean; const FileName: TStringDirectoryFilename); var LS: TStringList; MyClipboard: TClipboard; Nb, i: Integer; MyErreur: TMessaqeErreurGHTopoCompiler; begin Nb := GetNbMessagesErreur(); AfficherMsgClass(self, 'ExportListeErreursToCSV(): %d items', [Nb]); if (Nb = 0) then exit; LS := TStringList.Create; try LS.Clear; LS.Add(FileName); LS.Add('No' + FIELD_SEPARATOR_TAB + 'Table' + FIELD_SEPARATOR_TAB + 'Index' + FIELD_SEPARATOR_TAB + 'Criticite' + FIELD_SEPARATOR_TAB + 'Couleur' + FIELD_SEPARATOR_TAB + 'Description'); for i := 0 to Nb -1 do begin MyErreur := GetMessageErreur(i); LS.Add(MyErreur.toLineCSV(i)); end; if (ToClipBoard) then begin MyClipboard := TClipboard.Create(ctClipBoard); try MyClipboard.AsText := LS.Text; finally FreeandNil(MyClipboard); end; end else begin LS.SaveToFile(FileName); end; LS.Clear; finally FreeandNil(LS); end; end; procedure TToporobotStructure2012.ExportListeEntetesSeries(const ToClipBoard: boolean; const FileName: TStringDirectoryFilename); var LS: TStringList; MyClipboard: TClipboard; i: integer; S: TObjSerie; procedure Wrtln(const S: string); begin LS.Add(S); end; begin AfficherMsgClass(self, 'ExportListeEntetesSeries'); LS := TStringList.Create; try LS.Clear; Wrtln('Serie' + FIELD_SEPARATOR_TAB + 'Nom serie' + FIELD_SEPARATOR_TAB + 'Entree' + FIELD_SEPARATOR_TAB + 'Reseau' + FIELD_SEPARATOR_TAB + 'Ser Dep' + FIELD_SEPARATOR_TAB + 'Pt Dep' + FIELD_SEPARATOR_TAB + 'Ser Arr' + FIELD_SEPARATOR_TAB + 'Pt Arr' + FIELD_SEPARATOR_TAB + 'NbPts'); for i := 0 to GetNbSeries - 1 do begin S := GetSerie(i); Wrtln(S.toLineHeaderCSV()); end; if (ToClipBoard) then begin MyClipboard := TClipboard.Create(ctClipBoard); try MyClipboard.AsText := LS.Text; finally FreeandNil(MyClipboard); end; end else begin LS.SaveToFile(FileName); end; LS.Clear; finally FreeandNil(LS); end; end; // Exports CSV procedure TToporobotStructure2012.ExportListeAntennesCSV(const FileName: TStringDirectoryFilename); var fp: TextFile; QNbAntennes, i: Integer; VA: TViseeAntenne; EWE: String; begin QNbAntennes := self.GetNbAntennes(); AfficherMsgClass(self, 'ExportListeAntennesCSV(): %d splays to file %s', [QNbAntennes, FileName]); if (0 = QNbAntennes) then exit; AssignFile(fp, FileName); try Rewrite(fp); WriteLn(fp, 'No' + FIELD_SEPARATOR_TAB + 'Serie' + FIELD_SEPARATOR_TAB + 'Point' + FIELD_SEPARATOR_TAB + 'Longueur' + FIELD_SEPARATOR_TAB + 'Azimut' + FIELD_SEPARATOR_TAB + 'Pente' + FIELD_SEPARATOR_TAB + 'Obs'); for i := 1 to QNbAntennes - 1 do begin VA := GetViseeAntenne(i); if (VA.Longueur > 0.001) then begin EWE := FormatterInteger(i) + FIELD_SEPARATOR_TAB + FormatterInteger(VA.SerieDepart) + FIELD_SEPARATOR_TAB + FormatterInteger(VA.PtDepart) + FIELD_SEPARATOR_TAB + FormatterNombreOOo(VA.Longueur, 3) + FIELD_SEPARATOR_TAB + FormatterNombreOOo(VA.Azimut , 3) + FIELD_SEPARATOR_TAB + FormatterNombreOOo(VA.Pente , 3); Writeln(fp, EWE); end; end; finally CloseFile(fp); end; end; // export brut des séries (sans entête) pour construction de tableaux croisés dynamiques sur tableur procedure TToporobotStructure2012.ExportSeriesCSV(const QFileName: TStringDirectoryFilename); const FMT666 = FORMAT_NB_INTEGER + FIELD_SEPARATOR_TAB + FORMAT_STRING + FIELD_SEPARATOR_TAB + FORMAT_STRING + FIELD_SEPARATOR_TAB + FORMAT_STRING + FIELD_SEPARATOR_TAB + FORMAT_STRING + FIELD_SEPARATOR_TAB + FORMAT_NB_INTEGER + FIELD_SEPARATOR_TAB + FORMAT_NB_INTEGER + FIELD_SEPARATOR_TAB + FORMAT_STRING + FIELD_SEPARATOR_TAB + FORMAT_STRING + FIELD_SEPARATOR_TAB + FORMAT_STRING + FIELD_SEPARATOR_TAB + FORMAT_STRING + FIELD_SEPARATOR_TAB + FORMAT_STRING + FIELD_SEPARATOR_TAB + FORMAT_STRING + FIELD_SEPARATOR_TAB + FORMAT_STRING + FIELD_SEPARATOR_TAB + FORMAT_STRING + FIELD_SEPARATOR_TAB + FORMAT_STRING; var fp : TextFile; EWE: String; NbSeries, i, nv, v: Integer; MySerie: TObjSerie; MyReseau: TReseau; MyEntrance: TEntrance; MyVisee: TUneVisee; MySecteur: TSecteur; begin NbSeries := GetNbSeries(); AfficherMsgClass(self, 'ExportSeriesCSV: %d series to file %s', [NbSeries, QFileName]); AssignFile(fp, QFileName); try ReWrite(fp); // entête EWE := 'Serie' + FIELD_SEPARATOR_TAB + 'Entree' + FIELD_SEPARATOR_TAB + 'Reseau' + FIELD_SEPARATOR_TAB + 'Secteur' + FIELD_SEPARATOR_TAB + 'Type' + FIELD_SEPARATOR_TAB + 'Code' + FIELD_SEPARATOR_TAB + 'Expe' + FIELD_SEPARATOR_TAB + 'Longueur' + FIELD_SEPARATOR_TAB + 'Azimut' + FIELD_SEPARATOR_TAB + 'Pente' + FIELD_SEPARATOR_TAB + 'LG' + FIELD_SEPARATOR_TAB + 'LD' + FIELD_SEPARATOR_TAB + 'HZ' + FIELD_SEPARATOR_TAB + 'HN' + FIELD_SEPARATOR_TAB + 'IDTerrain' + FIELD_SEPARATOR_TAB + 'Commentaires'; WriteLn(fp, EWE); for i := 0 to NbSeries - 1 do begin MySerie := GetSerie(i); MyReseau := GetReseau(MySerie.NumeroReseau); MyEntrance := GetEntrance(MySerie.NumeroEntrance); nv := MySerie.NbVisees; for v := 0 to nv - 1 do begin MyVisee := MySerie.GetVisee(v); MySecteur := GetSecteur(MyVisee.IDSecteur); EWE := Format(FMT666, [ MySerie.NumeroDeSerie, MyEntrance.eNomEntree, MyReseau.NomReseau, MySecteur.NomSecteur, GetDescTypeVisee(MyVisee.TypeVisee), MyVisee.Code, MyVisee.Expe, FormatterNombreOOo(MyVisee.Longueur, 3, false), FormatterNombreOOo(MyVisee.Azimut, 3, false), FormatterNombreOOo(MyVisee.Pente, 3, false), FormatterNombreOOo(MyVisee.LG, 3, false), FormatterNombreOOo(MyVisee.LD, 3, false), FormatterNombreOOo(MyVisee.HZ, 3, false), FormatterNombreOOo(MyVisee.HN, 3, false), MyVisee.IDTerrainStation, MyVisee.Commentaires ]); // remplacer les doubles quotes par une paire de simples quotes // (doubles quotes sont interprétées par Calc) EWE := StringReplace(EWE, '"', '''''', [rfReplaceAll]); WriteLn(fp, EWE); end; end; finally CloseFile(fp); end; end; // filtres perso procedure TToporobotStructure2012.AddFiltrePerso(const FiltrePerso: TFiltrePersonnalise); begin FTableFiltresPersonnalises.AddElement(FiltrePerso); end; function TToporobotStructure2012.GetFiltrePerso(const NumFiltrePerso: integer): TFiltrePersonnalise; begin Result := FTableFiltresPersonnalises.GetElement(NumFiltrePerso); end; procedure TToporobotStructure2012.PutFiltrePerso(const NoFiltrePerso: integer; const AFiltrePerso: TFiltrePersonnalise); begin FTableFiltresPersonnalises.PutElement(NoFiltrePerso, AFiltrePerso); end; function TToporobotStructure2012.RemoveFiltrePerso(const Idx: integer): boolean; begin result :=FTableFiltresPersonnalises.RemoveElement(Idx); end; function TToporobotStructure2012.GetNbFiltresPersos(): integer; begin Result := FTableFiltresPersonnalises.GetNbElements(); end; function TToporobotStructure2012.GetLastFiltrePerso(): TFiltrePersonnalise; var Nb: Integer; begin Nb := self.GetNbFiltresPersos() - 1; Result := GetFiltrePerso(Nb); end; procedure TToporobotStructure2012.ViderListeFiltres(); begin FTablePointsOfInterest.ClearListe(); end; // Points d'intérêt procedure TToporobotStructure2012.AddPointOfInterest(constref APOI: TGHTopoPointOfInterest); begin FTablePointsOfInterest.AddElement(APOI); end; function TToporobotStructure2012.GetPointOfInterest(const Idx: integer): TGHTopoPointOfInterest; begin Result := FTablePointsOfInterest.GetElement(Idx); end; procedure TToporobotStructure2012.PutPointOfInterest(const Idx: integer; const APOI: TGHTopoPointOfInterest); begin FTablePointsOfInterest.PutElement(Idx, APOI); end; function TToporobotStructure2012.RemovePointOfInterest(const Idx: integer): boolean; var MyPOI: TGHTopoPointOfInterest; MySerie: TObjSerie; QIdxSerie: integer; MyStation: TUneVisee; begin result := false; MyPOI := GetPointOfInterest(Idx); if (GetSerieByNumeroSerie(MyPOI.Serie, MySerie, QIdxSerie)) then begin MyStation := MySerie.GetVisee(MyPOI.Station); // Basculer le POI à DONE MyStation.Commentaires := StringReplace(MyStation.Commentaires, KEYWORD_POI_TODO, KEYWORD_POI_DONE, [rfIgnoreCase]); MySerie.PutVisee(MyPOI.Station, MyStation); // et supprimer le POI de la liste FTablePointsOfInterest.RemoveElement(Idx); result := True; end; end; procedure TToporobotStructure2012.RecenserPointsOfInterest(); var i, j, NbV: Integer; MySerie: TObjSerie; MyVisee: TUneVisee; MyPOI : TGHTopoPointOfInterest; WU: String; P1, P2: SizeInt; EWE1, EWE2: Boolean; begin AfficherMsgClass(self, 'RecenserPointsOfInterest(): %d series)', [GetNbSeries()]); FTablePointsOfInterest.ClearListe(); for i := 0 to GetNbSeries() - 1 do begin MySerie := GetSerie(i); NbV := MySerie.NbVisees; if (NbV > 0) then begin for j := 0 to NbV - 1 do begin MyVisee := MySerie.GetVisee(j); WU := Trim(LowerCase(MyVisee.IDTerrainStation + MyVisee.Commentaires)); P1 := Pos(KEYWORD_POI_TODO, WU); P2 := Pos(KEYWORD_POI_DONE, WU); EWE1 := (P1 > 0); EWE2 := (P2 > 0); MyPOI.Statut := poiUNKNOWN; if (EWE1 OR EWE2) then begin MyPOI.Couleur := clGray; if (EWE1) then begin MyPOI.Statut := poiTODO; MyPOI.Couleur := clAqua; MyPOI.Description := Trim(StringReplace(MyVisee.Commentaires, KEYWORD_POI_TODO, '', [rfReplaceAll, rfIgnoreCase])); end else if (EWE2) then begin MyPOI.Statut := poiDONE; MyPOI.Couleur := clGreen; MyPOI.Description := Trim(StringReplace(MyVisee.Commentaires, KEYWORD_POI_DONE, '', [rfReplaceAll, rfIgnoreCase])); end; MyPOI.LabelTerrain := MyVisee.IDTerrainStation; MyPOI.Serie := MySerie.NumeroDeSerie; MyPOI.Station := j; MyPOI.Position.Empty(); self.AddPointOfInterest(MyPOI); end; end; end; end; end; function TToporobotStructure2012.GetNbPointsOfInterests(): integer; begin Result := FTablePointsOfInterest.GetNbElements(); end; // Recalculer les LRUDData // QDefL, QDefR, QDefU, QDefD: Valeurs par défaut function TToporobotStructure2012.CalcLRUD_AllStations(const QDefL, QDefR, QDefU, QDefD: double; const QCallbackProgression: TProcDisplayProgression): boolean; var i: Integer; MySerie: TObjSerie; begin AfficherMsgClassAtAllConsoles(self, 'CalcLRUD_AllStations(): Default L: %.2f, R: %.2f, U: %.2f, D: %.2f', [QDefL, QDefR, QDefU, QDefD]); for i := 1 to self.NbSeries - 1 do begin MySerie := self.GetSerie(i); if (Assigned(QCallbackProgression)) then QCallbackProgression(format('Process %d: %d - %s', [i, MySerie.NumeroDeSerie, MySerie.NomSerie]), i, 0, self.NbSeries - 1, 1); self.CalcLRUD_AllStationsOfTheSerie(MySerie, QDefL, QDefR, QDefU, QDefD); // TObjSerie est un pointeur. Pas de PutSerie() end; end; end. // Import SexyTopo texte (désactivé, code à revoir +++ ) { function TToporobotStructure2012.LoadFromSexyTopoTXT(const FichierTXT: TStringDirectoryFilename): integer; const NB_HEADING_LINES_SKIPPED = 5; var QDateSeanceTopo: TDateTime; EPSGDefault : TLabelSystemesCoordsEPSG; MyEntrance: TEntrance; MyCode: TCode; MyExpe: TExpe; i, nbSeries, QIdx, QNbVisees, s: Integer; ListeOfTGHStringArray: TListeOfTGHStringArray; QNomEtude: string; Nb: LongInt; MyAntenne: TViseeAntenne; QStationCourante, QStationSuivante: TToporobotIDStation; QStationDepart, QStationArrivee : TToporobotIDStation; QSerieCourante: TObjSerie; EWE0, EWE1: TGHStringArrayExt; AVisee: TUneVisee; procedure QMakeAndAddShotFromStrArr(const QCode: TCode; const QExpe: TExpe; const EWE: TGHStringArrayExt); var MyVisee: TUneVisee; begin MyVisee.Empty(''); MyVisee.setFrom(0, tgDEFAULT, 0, QCode.IDCode, QExpe.IDExpe, EWE.getFloat(2, -1.00), EWE.getFloat(3, 0.00), EWE.getFloat(4, 0.00), 0.0, 0.0, 0.0, 0.0, Now(), '', StringReplace(EWE.getString(6), '"', '', [rfReplaceAll])); if (MyVisee.Longueur > 0.001) then QSerieCourante.AddVisee(MyVisee); end; begin (* TRIP DATE 1970-01-01 DECLINATION 0.00 DATA *alias station - .. 1.0 1.1 0.010 45.00 45.00 1.1 - 3.804 333.14 4.48 1.1 - 2.553 299.69 14.90 1.1 - 2.277 276.40 13.00 1.1 1.2 3.825 333.73 -9.89 ; //from: 3.832 333.80 -9.73, 3.825 333.67 -9.93, 3.817 333.71 -10.01 1.2 - 3.782 334.50 -1.25 1.2 - 2.525 311.86 3.63 1.2 1.3 6.930 338.00 0.00 1.3 1.4 9.810 300.00 0.00 1.2 2.1 9.330 183.00 0.00 2.1 2.2 6.660 155.00 0.00 2.2 2.3 6.420 187.00 0.00 2.3 2.4 9.800 212.00 -1.00 2.2 3.1 6.440 266.00 0.00 3.1 3.2 6.660 254.00 9.00 //*) AfficherMsgErrClass(self, 'LoadFromSexyTopoTXT(): %s', [FichierTXT]); AfficherMessageErreur('===================='); AfficherMessageErreur('Limitations connues:'); AfficherMessageErreur('- Les boucles ne sont pas fermées, par choix technique'); AfficherMessageErreur('- Les LRUD data doivent être reconstruites'); AfficherMessageErreur('- Toutes les séries doivent DEBUTER par un point connu.'); AfficherMessageErreur(' Si une série dont le début est en nn.0 arrive sur une série connue, son début sera en 1.0'); AfficherMessageErreur(''); // Fichier introuvable ? OK, On sort if (not FileExistsUTF8(FichierTXT)) then Exit(-32); QDateSeanceTopo := Now(); ReInitialiser(True); // nom étude par défaut = nom du fichier SetNomEtude(ExtractFileNameWithoutExt(FichierTXT)); EPSGDefault.CodeEPSG := DEFAULT_SYSTEME_COORDONNEES_CODE_EPSG; EPSGDefault.NomEPSG := DEFAULT_SYSTEME_COORDONNEES_NOM; SetCodeEPSGSystemeCoordonnees(EPSGDefault); MyEntrance.eRefSer := 1; MyEntrance.eRefSt := 0; MyEntrance.eFixed := True; MyEntrance.eCouleur := clBlue; MyEntrance.eNomEntree := 'Main Entrance'; MyEntrance.eIDTerrain := '1.0'; MyEntrance.ePosition.Empty(); MyEntrance.eObserv := ''; AddEntrance(MyEntrance); MyCode.setUsualParameters(1, 360.00, 360.00, 1.00, 0.01, 1.00, 1.00, 0.00, 0.00, 0.00, 'Topo du ' + DatePascalToDateSQL(QDateSeanceTopo)); self.AddCode(MyCode); MyExpe.setFrom(1, YearOf(QDateSeanceTopo), MonthOf(QDateSeanceTopo), DayOf(QDateSeanceTopo), 6, cdmAUTOMATIQUE, 0.00, 'Speleometre', 'Speleographe', 'Expe01'); self.AddExpe(MyExpe); AfficherMessageErreur('*** %d entrances, %d reseaux, %d secteurs, %d codes, %d seances, %d series', [GetNbEntrances(), GetNbReseaux(), GetNbSecteurs(), GetNbCodes(), GetNbExpes(), GetNbSeries()]); // contrôles codes et expés for i := 0 to GetNbCodes() - 1 do begin MyCode := GetCode(i); AfficherMessageErreur('-- %d: Code: %d, UB: %.2f, UC: %.2f', [i, MyCode.IDCode, MyCode.GradAz, MyCode.GradInc]); end; for i := 0 to GetNbExpes() - 1 do begin MyExpe := GetExpe(i); AfficherMessageErreur('-- %d: Expe: %d, %s, %s', [i, MyExpe.IDExpe, DatePascalToDateSQL(MyExpe.DateExpe), MyExpe.Commentaire]); end; //************************* ListeOfTGHStringArray := TListeOfTGHStringArray.Create; try MyCode := GetLastCode(); MyExpe := GetLastExpe(); ListeOfTGHStringArray.ClearListe(); ListeOfTGHStringArray.LoadFromFile(FichierTXT, NB_HEADING_LINES_SKIPPED, FIELD_SEPARATOR_TAB, 'PLAN', QNomEtude); self.SetNomEtude(QNomEtude); AfficherMessageErreur(self.GetNomEtude()); // contrôle et traitements Nb := ListeOfTGHStringArray.GetNbElements(); AfficherMessageErreur('==== %d', [Nb]); if (0 = Nb) then exit; // afficher les lignes for i := 0 to ListeOfTGHStringArray.GetNbElements() - 1 do AfficherMessageErreur(ListeOfTGHStringArray.DebugLine(i)); // on extrait les antennes (lignes dont le champ 2 contient un tiret) // et on vire les lignes concernées for i := Nb -1 downto 0 do begin EWE0 := ListeOfTGHStringArray.GetElement(i); if (Pos(EWE0.getString(1), '-') > 0) then ListeOfTGHStringArray.RemoveElement(i); QStationDepart.setFrom(EWE0.getString(0)); MyAntenne.EntranceRatt:= 0; MyAntenne.Reseau := 0; MyAntenne.Secteur := 0; MyAntenne.MarkedForDelete := false; MyAntenne.SerieDepart := QStationDepart.aSerie; MyAntenne.PtDepart := QStationDepart.aStation; MyAntenne.setLongAzInc(EWE0.getFloat(2), EWE0.getFloat(3), EWE0.getFloat(4)); if (MyAntenne.Longueur > 0.00) then AddViseeAntenne(MyAntenne); end; Nb := GetNbAntennes(); AfficherMessageErreur('==== %d antennes ajoutées', [Nb]); // contrôle: Visées en antenne if (Nb > 0) then begin for i := 0 to Nb-1 do AfficherMessageErreur(GetViseeAntenne(i).DebugString()); end; // afficher les lignes AfficherMessageErreur(''); AfficherMessageErreur('Après purge antennes'); // Ajouter une ligne supplémentaire en fin de tableau EWE0 := ListeOfTGHStringArray.GetLastElement(); QStationCourante.setFrom(EWE0.getString(0)); EWE0.setString(0, QStationCourante.ToStringWithNumStationIncremented()); QStationCourante.setFrom(EWE0.getString(1)); EWE0.setString(1, QStationCourante.ToStringWithNumStationIncremented()); EWE0.setFloat(2, 0.0001); EWE0.setFloat(3, 45.00); EWE0.setFloat(4, 0.00); EWE0.setString(5, 'Added for parsing'); ListeOfTGHStringArray.AddElement(EWE0); // Trier le tableau ListeOfTGHStringArray.SortByFirstColumn(); // contrôle: ListeOfTGHStringArray.DebugPrintAllLines('Liste des visées'); QStationCourante.setFrom(0,0); QStationDepart.setFrom(0, 0); QStationArrivee.setFrom(0, 0); QSerieCourante := self.GetLastSerie(); AfficherMessageErreur('Traitement'); AfficherMessageErreur(''); CreateNewSerie(1, 0, 1, 'Série principale'); QSerieCourante := GetLastSerie(); // Ajout d'un item supplémentaire pour ne pas oublier la dernière visée EWE1 := ListeOfTGHStringArray.GetLastElement(); ListeOfTGHStringArray.AddElement(EWE1); for i := 0 to ListeOfTGHStringArray.GetNbElements() - 2 do begin EWE0 := ListeOfTGHStringArray.GetElement(i); EWE1 := ListeOfTGHStringArray.GetElement(i+1); QStationCourante.setFrom(EWE0.getString(0)); QStationSuivante.setFrom(EWE1.getString(0)); QStationDepart.setFrom(EWE0.getString(0)); QStationArrivee.setFrom(EWE0.getString(1)); GetSerieByNumeroSerie(QStationDepart.aSerie, QSerieCourante, QIdx); if (QStationDepart.aSerie <> QStationArrivee.aSerie) then begin //AfficherMessageErreur('Changement de série %d: %s', [i, QStationDepart.])); if (not GetSerieByNumeroSerie(QStationArrivee.aSerie, QSerieCourante, QIdx)) then begin AfficherMessageErreur('Ajout d''une série partant de ' + QStationDepart.ToString()); CreateNewSerie(QStationDepart.aSerie, QStationDepart.aStation, QStationArrivee.aSerie, format('Serie partant de %s', [QStationDepart.ToString()])); QSerieCourante := GetLastSerie(); end else AfficherMessageErreur('Série existante: %d - %s', [QSerieCourante.NumeroDeSerie, QSerieCourante.StationDepart.ToString()]); end; //else begin QMakeAndAddShotFromStrArr(MyCode, MyExpe, EWE0); end; // et on ajoute la visée de la dernière ligne à la série courante if (i = (ListeOfTGHStringArray.GetNbElements() - 2)) then begin EWE0 := ListeOfTGHStringArray.GetElement(i+1); QStationCourante.setFrom(EWE0.getString(0)); if (not GetSerieByNumeroSerie(QStationCourante.aSerie, QSerieCourante, QIdx)) then QSerieCourante := GetLastSerie(); QMakeAndAddShotFromStrArr(MyCode, MyExpe, EWE0); end; end; // et on ajoute une station (0.01, 45, -45) à la série 1 //QSerieCourante //CreateNewSerie(1, 0, 1, 'Galerie principale'); (* 1.0 1.1 0.010 45.00 0.00 1.1 1.2 4.149 22.54 0.84 ; {from: 4.146 22.17 -0.10, 4.147 22.60 1.16, 4.154 22.86 1.45} 1.2 1.3 2.863 36.77 -7.34 ; {from: 2.862 36.69 -8.03, 2.867 36.89 -7.24, 2.859 36.74 -6.75} 1.3 1.4 4.130 16.89 -2.03 ; {from: 4.125 17.84 -1.32, 4.130 16.30 -2.22, 4.136 16.52 -2.54} 1.3 2.1 1.925 111.24 16.29 ; {from: 1.923 111.21 16.61, 1.925 111.13 16.10, 1.928 111.39 16.16} 2.1 2.2 3.405 37.32 34.02 ; {from: 3.412 37.28 33.50, 3.413 37.39 34.35, 3.391 37.28 34.20} 2.2 2.3 1.903 101.01 21.69 ; {from: 1.902 100.10 22.07, 1.902 101.34 21.50, 1.904 101.60 21.51} 1.4 1.5 2.774 330.75 27.34 ; {from: 2.773 330.12 26.66, 2.770 331.00 27.60, 2.778 331.13 27.75} 1.5 1.6 3.799 26.07 13.25 ; {from: 3.785 25.89 13.35, 3.791 25.93 13.49, 3.822 26.38 12.90} 1.4 3.1 1.783 155.10 18.88 ; {from: 1.786 155.28 18.01, 1.779 155.04 19.29, 1.783 154.98 19.35} 3.1 3.2 2.315 200.20 -28.02 ; {from: 2.319 200.31 -27.71, 2.317 200.26 -28.10, 2.308 200.03 -28.23} 3.2 3.3 2.906 308.20 -6.58 ; {from: 2.922 307.38 -6.70, 2.899 308.73 -6.54, 2.896 308.50 -6.50} 3.3 3.4 6.228 17.10 3.09 ; {from: 6.234 17.22 3.00, 6.226 17.01 3.14, 6.223 17.06 3.12} 3.4 3.5 11.904 342.85 -3.29 ; {from: 11.915 342.78 -3.29, 11.900 342.85 -3.42, 11.897 342.93 -3.17} 3.5 3.6 11.357 63.15 6.25 ; {from: 11.354 63.18 6.11, 11.348 63.15 6.50, 11.369 63.11 6.12} 3.6 3.7 9.438 106.68 -4.37 ; {from: 9.442 106.80 -4.41, 9.434 106.62 -4.32, 9.437 106.61 -4.39} 3.5 11.1 11.436 63.68 1.62 ; {from: 11.426 63.82 1.54, 11.437 63.63 1.69, 11.446 63.60 1.62} 11.1 11.2 3.385 42.71 -0.95 ; {from: 3.387 42.73 -1.11, 3.384 42.66 -0.93, 3.384 42.73 -0.80} 11.2 11.3 8.227 4.91 -1.87 ; {from: 8.230 4.97 -1.88, 8.225 4.90 -1.87, 8.227 4.88 -1.86} 11.3 11.4 7.091 305.70 -5.50 ; {from: 7.088 305.74 -5.51, 7.097 305.72 -5.52, 7.087 305.64 -5.49} 11.4 11.5 14.387 308.46 -2.59 ; {from: 14.387 308.49 -2.62, 14.387 308.43 -2.56, 14.388 308.46 -2.59} 11.5 11.6 17.105 229.12 -3.13 ; {from: 17.103 229.17 -3.15, 17.107 229.13 -3.08, 17.106 229.07 -3.15} 11.6 11.7 14.349 118.31 1.19 ; {from: 14.360 118.27 1.12, 14.338 118.31 1.20, 14.348 118.34 1.25} 11.7 11.8 12.433 181.05 -2.94 ; {from: 12.428 180.95 -3.01, 12.431 181.08 -2.91, 12.439 181.14 -2.90} 11.8 11.9 4.082 82.57 23.46 ; {from: 4.088 82.50 23.68, 4.089 82.57 23.75, 4.069 82.64 22.95} //*) nbSeries := GetNbSeries(); AfficherMessageErreur('--> Ouverture des boucles et affectation des métadonnées: %d séries', [nbSeries]); for i := 0 to GetNbSeries() - 1 do begin QSerieCourante := GetSerie(i); QSerieCourante.SetSeriePtArr(QSerieCourante.NumeroDeSerie, QSerieCourante.NbVisees - 1); QSerieCourante.SetChanceObstacle(0, 0); QSerieCourante.SetNumeroEntranceReseau(0, 0); QSerieCourante.SetNomObsSerie('', ''); end; AfficherMessageErreur('--> Affichage de contrôle: %d séries', [nbSeries]); for i := 0 to GetNbSeries() - 1 do begin QSerieCourante := GetSerie(i); AfficherMessageErreur('%d: Serie: %d %s - Depart: %s, Arrivee: %s, Nb Pts: %d', [i, QSerieCourante.NumeroDeSerie, QSerieCourante.NomSerie, QSerieCourante.StationDepart.ToString(), QSerieCourante.GetStationArrivee().ToString(), QSerieCourante.NbVisees ]); QNbVisees := QSerieCourante.NbVisees; for s := 0 to QNbVisees - 1 do begin AVisee := QSerieCourante.GetVisee(s); AfficherMessageErreur(' %d.%d: %s', [QSerieCourante.NumeroDeSerie, s, AVisee.DebugString()]); end; end; AfficherMessageErreur('--> Préconditionnement de la BDD mémoire: %d séries', [nbSeries]); Preconditionner(FichierTXT); // contrôles, tris et définition des références AfficherMessageErreur('--> Calcul des LRUD data: %d séries', [nbSeries]); for i := 1 to nbSeries - 1 do CalcLRUD_AllStationsOfTheSerie(GetSerie(i)); AfficherMessageErreur('--> Importation terminée', [nbSeries]); AfficherMessageErreur(''); Result := GetNbSeries(); finally FreeAndNil(ListeOfTGHStringArray); end; end; //}