unit frmMaintenanceDocument; // 13/06/2019: Point de contrôle temporel (contrôle de version) {$INCLUDE CompilationParameters.inc} 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 LCLIntf, LCLType, CallDialogsStdVersion, ToporobotClasses2012, UnitEntitesExtended, UnitGraphes1, CadreViseesAntenne, CadreListeSeries, CadreListesSimples, UnitObjetSerie, ConvertisseurJPC, ExportationSQL, FileUtil, curredit, Forms, Controls, Graphics, Dialogs, Buttons, ComCtrls, ExtCtrls, StdCtrls, EditBtn; type TAttributsAChanger = set of (aacENTRANCES, aacRESEAUX, aacCODES, aacEXPES, aacSECTEURS); type { TdlgMaintenanceDocTopo } TdlgMaintenanceDocTopo = class(TForm) BitBtn1: TBitBtn; btnReattribuerAuxSeriesSelectionnees: TButton; btnReattribuerCode: TButton; btnReattribuerIDExpe: TButton; btnReattribuerIDSerie: TButton; btnModifier: TButton; btnSelectCode: TButton; btnSelectExpe: TButton; btnSelectReseau: TButton; btnSelectEntrance: TButton; btnSupprimerSeriesSelectionnees: TButton; btnRemoveUnGeoreferencedEntrances: TButton; btnRecalcLRUD: TButton; Button2: TButton; btnSystemeCorrdonnees: TButton; Button3: TButton; btnFixerViseesLongueurNulle: TButton; btnRechercherSeriesLibres: TButton; btnAttribRandomColorsExpes: TButton; CdrAntennes1: TCdrAntennes; CdrListeSeries1: TCdrListeSeries; CdrListesSimples1: TCdrListesSimples; chkIncludeSeriesLibresIsolees: TCheckBox; chkStructureOnly: TCheckBox; chkDoEntrances: TCheckBox; chkDoCodes: TCheckBox; chkDoSeances: TCheckBox; chkDoReseaux: TCheckBox; editDefaultL: TCurrencyEdit; editDefaultR: TCurrencyEdit; editDefaultU: TCurrencyEdit; editDefaultD: TCurrencyEdit; editNameSpace: TEdit; editCurrNumeroCode: TCurrencyEdit; editCurrNumeroExpe: TCurrencyEdit; editCurrNumeroReseau: TCurrencyEdit; editCurrNumeroEntree: TCurrencyEdit; editNomEtude: TEdit; editAncienIDCode: TCurrencyEdit; editAncienIDExpe: TCurrencyEdit; editAncienIDSerie: TCurrencyEdit; editNouvelIDCode: TCurrencyEdit; editNouvelIDExpe: TCurrencyEdit; editNouvelIDSerie: TCurrencyEdit; editSQLFilename: TFileNameEdit; GroupBox1: TGroupBox; Label1: TLabel; Label13: TLabel; Label14: TLabel; Label2: TLabel; Label3: TLabel; Label4: TLabel; Label5: TLabel; Label6: TLabel; Label7: TLabel; Label8: TLabel; Label9: TLabel; PageControl1: TPageControl; Panel1: TPanel; Panel2: TPanel; pnlExportSQL: TPanel; Panel5: TPanel; Panel7: TPanel; Panel8: TPanel; Panel9: TPanel; lbMessages: TStaticText; tabShtListesSimples: TTabSheet; tabshtSeries: TTabSheet; tabShtAntennes: TTabSheet; tabshtGeneral: TTabSheet; procedure btnAttribRandomColorsExpesClick(Sender: TObject); procedure btnFixerAutoloopsClick(Sender: TObject); procedure btnFixerViseesLongueurNulleClick(Sender: TObject); procedure btnModifierClick(Sender: TObject); procedure btnReattribuerAuxSeriesSelectionneesClick(Sender: TObject); procedure btnReattribuerCodeClick(Sender: TObject); procedure btnReattribuerIDExpeClick(Sender: TObject); procedure btnReattribuerIDSerieClick(Sender: TObject); procedure btnRecalcLRUDClick(Sender: TObject); procedure btnRechercherSeriesLibresClick(Sender: TObject); procedure btnSelectCodeClick(Sender: TObject); procedure btnSelectEntranceClick(Sender: TObject); procedure btnSelectExpeClick(Sender: TObject); procedure btnSelectReseauClick(Sender: TObject); procedure btnSupprimerSeriesSelectionneesClick(Sender: TObject); procedure btnRemoveUnGeoreferencedEntrancesClick(Sender: TObject); procedure Button2Click(Sender: TObject); procedure btnSystemeCorrdonneesClick(Sender: TObject); procedure Button3Click(Sender: TObject); private FDocTopo : TToporobotStructure2012; FBDDEntites: TBDDEntites; FGraphe : TPathFindingGraphe; FConvertisseurCoords: TConversionSysteme; FDoPostAction: boolean; procedure DisplayProgression(const Etape: string; const Done, Starting, Ending, Step: integer); procedure GenererSubsetXTB(const QFilename: TStringDirectoryFilename); experimental; function GetAttributsAChanger(): TAttributsAChanger; procedure ReattribuerEntreeReseauCodeExpe(const AttributsAChanger: TAttributsAChanger; const QIdxEntrance: TNumeroEntrance; const QIdxReseau : TNumeroReseau; const QIdxCode : TNumeroCode; const QIdxExpe : TNumeroExpe); // reprojection des entrées procedure ReprojeterLesEntrees(const OldEPSG, NewEPSG: TLabelSystemesCoordsEPSG); public function Initialiser(const FD: TToporobotStructure2012; const FE: TBDDEntites; const FG: TPathFindingGraphe; const FC: TConversionSysteme; const ListeSeriesSelectionnees: string): boolean; procedure Finaliser(); function DoPostAction(const BoolDummy: boolean): boolean; end; var dlgMaintenanceDocTopo: TdlgMaintenanceDocTopo; implementation {$R *.lfm} uses DGCDummyUnit; { TdlgMaintenanceDocTopo } procedure TdlgMaintenanceDocTopo.ReattribuerEntreeReseauCodeExpe(const AttributsAChanger: TAttributsAChanger; const QIdxEntrance: TNumeroEntrance; const QIdxReseau : TNumeroReseau; const QIdxCode : TNumeroCode; const QIdxExpe : TNumeroExpe); var i, NbSeries, NbVisees, j: Integer; MySerie : TObjSerie; MyVisee: TUneVisee; EWE: String; begin if (not GHTopoQuestionOuiNon('Cette fonction peut désorganiser la base - Continuer ?')) then Exit; EWE := format('%s.ReattribuerEntreeReseauCodeExpe(%d, %d, %d, %d', [self.ClassName, QIdxEntrance, QIdxReseau, QIdxCode, QIdxExpe]); // on checke les numéros de expé, code, réseau if (not FDocTopo.ExistsIdxEntrance(QIdxEntrance)) then Exit; if (not FDocTopo.ExistsIdxReseau(QIdxReseau)) then Exit; if (not FDocTopo.ExistsIdxCode(QIdxCode)) then Exit; if (not FDocTopo.ExistsIdxExpe(QIdxExpe)) then Exit; NbSeries := FDocTopo.NbSeries; for i := 0 to NbSeries - 1 do begin if (CdrListeSeries1.IsItemListeSelected(i)) then begin MySerie := FDocTopo.GetSerie(i); NbVisees := MySerie.NbVisees; lbMessages.Caption := Format('--> %d: %d (%d stations): %s', [i, MySerie.NumeroDeSerie, NbVisees, MySerie.NomSerie]); if (aacENTRANCES in AttributsAChanger) then MySerie.SetNumeroEntrance(QIdxEntrance); if (aacRESEAUX in AttributsAChanger) then MySerie.SetNumeroReseau(QIdxReseau); if (aacCODES in AttributsAChanger) then begin for j := 0 to NbVisees - 1 do begin MyVisee := MySerie.GetVisee(j); MyVisee.Code := QIdxCode; MySerie.PutVisee(j, MyVisee); end; end; if (aacEXPES in AttributsAChanger) then begin for j := 0 to NbVisees - 1 do begin MyVisee := MySerie.GetVisee(j); MyVisee.Expe := QIdxExpe; MySerie.PutVisee(j, MyVisee); end; end; end; end; end; procedure TdlgMaintenanceDocTopo.GenererSubsetXTB(const QFilename: TStringDirectoryFilename); var MySubsetXTB: TToporobotStructure2012; P1: TPoint3Df; EEE: TEntrance; WU: String; i, NbSeriesSelectionnees, Nb: Integer; MySerieCible , MySerieSource: TObjSerie; begin AfficherMsgClass(self, 'GenererSubsetXTB(): %s', [QFilename]); MySubsetXTB := TToporobotStructure2012.Create; try try {$WARNING Ne pas utiliser TToporobotStructure2012.ReInitialiser() ici} // MySubsetXTB.ReInitialiser(True); MySubsetXTB.SetDatabaseName(QFilename); MySubsetXTB.SetCodeEPSGSystemeCoordonnees(FDocTopo.CodeEPSGSystemeCoordonnees); MySubsetXTB.SetNomEtude('Sous-ensemble de ' + FDocTopo.GetNomEtude()); P1.Empty(); MySubsetXTB.SetDefaultCoords(P1); WU := ''; // mettre ici les numéros de séries extraites; MySubsetXTB.SetCommentairesEtude(WU); MySubsetXTB.ClearListeSeries(); MySubsetXTB.ViderListeViseesAntennes(); MySubsetXTB.ViderTablesSimples(); // création de l'entrée 1.0 EEE.setFrom('Point_0', '1.0', P1, 1, 0, clRed,'Point de rattachement', True, tteGROTTE); MySubsetXTB.AddEntrance(EEE); for i := 0 to FDocTopo.NbReseaux - 1 do MySubsetXTB.AddReseau(FDocTopo.GetReseau(i)); for i := 0 to FDocTopo.NbSecteurs - 1 do MySubsetXTB.AddSecteur(FDocTopo.GetSecteur(i)); for i := 0 to FDocTopo.NbCodes - 1 do MySubsetXTB.AddCode(FDocTopo.GetCode(i)); for i := 0 to FDocTopo.NbExpes - 1 do MySubsetXTB.AddExpe(FDocTopo.GetExpe(i)); // les séries (uniquement les séries sélectionnées) Nb := CdrListeSeries1.lsbListe.Count; {$NOTE: La ligne suivante est inutile: GHTopo reconstruira une série 0 au chargement} //FDocTopo.CreateNewSerie(1,0, -1, 'serie 0'); //TODO: Semble inutile A voir // première série if (CreateAndCopySerie(FDocTopo.GetSerie(1), MySerieCible)) then MySubsetXTB.AddSerie(MySerieCible); NbSeriesSelectionnees := 0; for i := 0 to Nb - 1 do begin if (CdrListeSeries1.IsItemListeSelected(i)) then begin Inc(NbSeriesSelectionnees); if (CreateAndCopySerie(FDocTopo.GetSerie(i), MySerieCible)) then MySubsetXTB.AddSerie(MySerieCible); end; end; MySubsetXTB.SaveToXTB(QFilename, mtabEXTENDEDTAB, tfWINDOWS); // finalisation MySubsetXTB.Finaliser(); // La série 1 du document original est détruite . Why ??? Réponse: Toujours ce pb de pointeur avec les TObjSerie. Résolu par CreateAndCopySerie(); //ShowMessageFmt('Après MySubsetXTB.Finaliser(): Série %d problématique: %s - %d', [MySerieSource.NumeroDeSerie, MySerieSource.NomSerie, MySerieSource.NbVisees]); except pass; end; finally FreeAndNil(MySubsetXTB); end; end; procedure TdlgMaintenanceDocTopo.btnReattribuerIDExpeClick(Sender: TObject); var E1, E2: TNumeroExpe; begin E1 := editAncienIDExpe.AsInteger; E2 := editNouvelIDExpe.AsInteger; FDocTopo.ReplaceIdxExpes(E1, E2); FDocTopo.ReplaceIndexInStations(E1, E2, mrsEXPES); FDocTopo.ReattribuerCodesExpesViseesAntennes(); end; procedure TdlgMaintenanceDocTopo.btnReattribuerIDSerieClick(Sender: TObject); var E2, E1: TNumeroSerie; MySerie: TObjSerie; QIdx: integer; begin E1 := editAncienIDSerie.AsInteger; E2 := editNouvelIDSerie.AsInteger; if (FDocTopo.GetSerieByNumeroSerie(E2, MySerie, QIdx)) then begin ShowMessageFmt('Série %d déjà attribuée: "%s"', [MySerie.NumeroDeSerie, MySerie.NomSerie]); exit; end; FDocTopo.ReplaceIndexSeriesInEntrances(E1, E2); FDocTopo.ReplaceIdxSeries(E1, E2); FDocTopo.ReattribuerCodesExpesViseesAntennes(); CdrListeSeries1.Relister(0); end; procedure TdlgMaintenanceDocTopo.btnRecalcLRUDClick(Sender: TObject); begin FDocTopo.CalcLRUD_AllStations(editDefaultL.Value, editDefaultR.Value, editDefaultU.Value, editDefaultD.Value, self.DisplayProgression); ShowMessage(rsDONE_ANY_PROCESS); end; procedure TdlgMaintenanceDocTopo.btnRechercherSeriesLibresClick(Sender: TObject); var ArrSeriesLibres: TArrayOfIntegers; EWE: String; begin ArrSeriesLibres := FDocTopo.RechercherSeriesLibres(); AfficherMessageErreur(ArrSeriesLibres.toString('; ')); EWE := ArrSeriesLibres.toCondensedString(chkIncludeSeriesLibresIsolees.Checked, ';' + #13#10); DisplayTextEditorFromString(tehmNONE, 'Plages de séries libres', EWE, True, True); end; procedure TdlgMaintenanceDocTopo.btnSelectCodeClick(Sender: TObject); var n: LongInt; begin n := editCurrNumeroCode.AsInteger; if (SelectionDansListe(FDocTopo, mslCODE, false, n, False)) then editCurrNumeroCode.AsInteger := n; end; procedure TdlgMaintenanceDocTopo.btnSelectEntranceClick(Sender: TObject); var n: LongInt; begin n := editCurrNumeroReseau.AsInteger; if (SelectionDansListe(FDocTopo, mslENTRANCES, false, n, False)) then editCurrNumeroEntree.AsInteger := n; end; procedure TdlgMaintenanceDocTopo.btnSelectExpeClick(Sender: TObject); var n: LongInt; begin n := editCurrNumeroExpe.AsInteger; if (SelectionDansListe(FDocTopo, mslEXPE, false, n, False)) then editCurrNumeroExpe.AsInteger := n; end; procedure TdlgMaintenanceDocTopo.btnSelectReseauClick(Sender: TObject); var n: LongInt; begin n := editCurrNumeroReseau.AsInteger; if (SelectionDansListe(FDocTopo, mslRESEAUX, false, n, False)) then editCurrNumeroReseau.AsInteger := n; end; procedure TdlgMaintenanceDocTopo.btnSupprimerSeriesSelectionneesClick(Sender: TObject); var n, i: Integer; begin n := FDocTopo.NbSeries; if (not GHTopoQuestionOuiNon('Ceci supprimera DEFINITIVEMENT les séries sélectionnées - Continuer ?')) then exit; for i := n - 1 downto 1 do begin if (CdrListeSeries1.IsItemListeSelected(i)) then FDocTopo.RemoveSerie(i); end; CdrListeSeries1.Relister(0); end; procedure TdlgMaintenanceDocTopo.btnRemoveUnGeoreferencedEntrancesClick(Sender: TObject); var i, Nb: Integer; EE: TEntrance; begin if (GHTopoQuestionOuiNon('Désactiver les entrées non géoréférencées')) then begin FDocTopo.FixerEntrancesWithoutValidRef(); end; CdrListesSimples1.ListerListesSimples(TModeBDD.mbddENTRANCES); end; procedure TdlgMaintenanceDocTopo.Button2Click(Sender: TObject); var QFileName: TStringDirectoryFilename; QIdxFilter: integer; MyTextEditor: String; begin if (not GHTopoQuestionOuiNon('Fonctionnalité expérimentale' + System.LineEnding + 'Le fichier XTB généré peut devoir être modifié' + System.LineEnding + 'Ceci ouvrira le fichier résultant dans un éditeur de texte ' + System.LineEnding + 'Continuer')) then Exit; QFileName := GetGHTopoDirectory() + 'Subset_001.xtb'; if (DoDialogSaveFile('Fichier XTB', '.xtb', QFileName, QIdxFilter)) then begin GenererSubsetXTB(QFileName); MyTextEditor := 'C:\Program Files\Notepad++\notepad++.exe'; RunExternalProgram(MyTextEditor, [QFilename], False); // On libère GHTopo immédiatement end; end; procedure TdlgMaintenanceDocTopo.btnSystemeCorrdonneesClick(Sender: TObject); var OldEPSG, NewEPSG: TLabelSystemesCoordsEPSG; begin OldEPSG := FDocTopo.CodeEPSGSystemeCoordonnees; if (SelectCoordinatesSystem(FConvertisseurCoords, NewEPSG)) then begin if (NewEPSG.CodeEPSG <> OldEPSG.CodeEPSG) then begin FDocTopo.SetCodeEPSGSystemeCoordonnees(NewEPSG); // acquittement NewEPSG := FDocTopo.CodeEPSGSystemeCoordonnees; btnSystemeCorrdonnees.Caption := NewEPSG.toString(); if (GHTopoQuestionOuiNon('Reprojeter les coordonnées des entrées')) then begin ReprojeterLesEntrees(OldEPSG, NewEPSG); FDoPostAction := true; end ; end; end; end; procedure TdlgMaintenanceDocTopo.Button3Click(Sender: TObject); var MyExportSQL: TExportationSQL; begin MyExportSQL := TExportationSQL.Create; try if (MyExportSQL.Initialiser(FDocTopo, chkStructureOnly.Checked, editSQLFilename.FileName)) then begin if (MyExportSQL.CreateDatabase('MyDatabase001')) then begin MyExportSQL.GenererTableEntrances('TableEntrances'); MyExportSQL.GenererTableCodes('TableCodes'); MyExportSQL.GenererTableExpes('TableExpes'); MyExportSQL.GenererTableSeries('TableSeries'); MyExportSQL.GenererTableVisees('TableVisees'); MyExportSQL.GenererTableAntennes('TableAntennes'); MyExportSQL.CloseDatabase(); end; MyExportSQL.Finaliser; end; showmessage('Terminé'); finally FreeAndNil(MyExportSQL); end; end; procedure TdlgMaintenanceDocTopo.DisplayProgression(const Etape: string; const Done, Starting, Ending, Step: integer); begin lbMessages.Caption := Etape; //AfficherMessageErreur('002' + Etape); Application.ProcessMessages; end; procedure TdlgMaintenanceDocTopo.btnReattribuerCodeClick(Sender: TObject); var E1, E2: TNumeroCode; begin E1 := editAncienIDCode.AsInteger; E2 := editNouvelIDCode.AsInteger; FDocTopo.ReplaceIdxCodes(E1, E2); FDocTopo.ReplaceIndexInStations(E1, E2, mrsCODES); FDocTopo.ReattribuerCodesExpesViseesAntennes(); end; procedure TdlgMaintenanceDocTopo.btnModifierClick(Sender: TObject); var MyNamespace: TNameSpace; begin //MyNamespace := FDocTopo.GetNameSpace(0); //MyNamespace.Nom := trim(editNameSpace.Text); //FDocTopo.PutNameSpace(0, MyNamespace); FDocTopo.SetNomEtude(trim(editNomEtude.Text)); self.Caption := 'Maintenance du document: ' + FDocTopo.GetNomEtude(); (* OldEPSG := FDocTopo.GetCodeEPSGSystemeCoordonnees(); NewEPSG := FConvertisseurCoords.GetCodeEPSGNomSysteme(cmbCodesEPSG.ItemIndex); if (NewEPSG.CodeEPSG <> OldEPSG.CodeEPSG) then begin if (GHTopoQuestionOuiNon('Ceci reprojettera les coordonnées des entrées - Continuer')) then begin FDocTopo.SetCodeEPSGSystemeCoordonnees(NewEPSG); ReprojeterLesEntrees(OldEPSG, NewEPSG); FDoPostAction := true; end else begin cmbCodesEPSG.ItemIndex := FConvertisseurCoords.GetIndexSystemeByCodeEPSG(OldEPSG.CodeEPSG); end; end; //*) end; procedure TdlgMaintenanceDocTopo.btnFixerViseesLongueurNulleClick(Sender: TObject); var Nb1, Nb2, Nb3, Nb4: Integer; begin Nb1 := FDocTopo.FixerViseesDeLongueurNulle(); Nb2 := FDocTopo.FixerEntrancesWithoutValidRef(); Nb3 := FDocTopo.FixerLesAutoloops(); Nb4 := FDocTopo.FixerExtremitesSeriesAt0and0(); ShowMessageFmt('Fixed: %d null shots, %d entrances, %d auto-loops, %d end of series', [Nb1, Nb2, Nb3, Nb4]); end; procedure TdlgMaintenanceDocTopo.btnAttribRandomColorsExpesClick(Sender: TObject); var i: Integer; MyExpe: TExpe; begin if (GHTopoQuestionOuiNon('Attribuer des couleurs aléatoires aux séances')) then begin for i := 1 to FDocTopo.NbExpes - 1 do begin MyExpe := FDocTopo.GetExpe(i); if (MyExpe.IdxCouleur > 1) then Continue; // IdxCouleur: 0 = blanc, 1 = noir; 2..255: autres couleurs Toporobot MyExpe.IdxCouleur := RandomRange(2, 255); FDocTopo.PutExpe(i, MyExpe); end; CdrListesSimples1.ListerListesSimples(TModeBDD.mbddEXPES); end; end; procedure TdlgMaintenanceDocTopo.btnFixerAutoloopsClick(Sender: TObject); var Nb: Integer; begin Nb := FDocTopo.FixerLesAutoloops(); end; function TdlgMaintenanceDocTopo.GetAttributsAChanger(): TAttributsAChanger; begin Result := []; if (chkDoEntrances.Checked) then Result := Result + [aacENTRANCES] else Result := Result - [aacENTRANCES]; if (chkDoReseaux.Checked) then Result := Result + [aacRESEAUX] else Result := Result - [aacRESEAUX]; if (chkDoCodes.Checked) then Result := Result + [aacCODES] else Result := Result - [aacCODES]; if (chkDoSeances.Checked) then Result := Result + [aacEXPES] else Result := Result - [aacEXPES]; end; procedure TdlgMaintenanceDocTopo.btnReattribuerAuxSeriesSelectionneesClick(Sender: TObject); var EWE: TAttributsAChanger; begin EWE := GetAttributsAChanger(); ReattribuerEntreeReseauCodeExpe(EWE, editCurrNumeroEntree.AsInteger, editCurrNumeroReseau.AsInteger, editCurrNumeroCode.AsInteger, editCurrNumeroExpe.AsInteger); CdrListeSeries1.Relister(0); end; function TdlgMaintenanceDocTopo.Initialiser(const FD: TToporobotStructure2012; const FE: TBDDEntites; const FG: TPathFindingGraphe; const FC: TConversionSysteme; const ListeSeriesSelectionnees: string): boolean; var MyCode: TCode; MyExpe: TExpe; // MyNameSpace: TNameSpace; procedure InitCaptions(); begin tabshtGeneral.Caption := GetResourceString(rsTBS_GENERAL); tabShtListesSimples.Caption := GetResourceString(rsTBS_LISTES_SIMPLES); tabshtSeries.Caption := GetResourceString(rsTBS_SERIES); tabShtAntennes.Caption := GetResourceString(rsTBS_ANTENNES); end; begin result := false; try InitCaptions(); FDoPostAction := false; FDocTopo := FD; FBDDEntites := FE; FGraphe := FG; FConvertisseurCoords := FC; self.Caption := 'Maintenance du document: ' + FDocTopo.GetNomEtude(); editNomEtude.Text := FDocTopo.GetNomEtude(); // espace de nom principal //MyNameSpace := FDocTopo.GetNameSpace(0); //editNameSpace.Text := MyNameSpace.Nom; CdrListesSimples1.InitialiserListeSimple(FDocTopo, FBDDEntites, nil, FGraphe, mbddCODES, 2.01); CdrAntennes1.Initialiser(FD, FBDDEntites); CdrListeSeries1.Initialiser(FD, nil, nil, [tbsSORT, tbsCSV, tbsHELP], True, ListeSeriesSelectionnees); // systèmes de coordonnées btnSystemeCorrdonnees.Caption := FDocTopo.CodeEPSGSystemeCoordonnees.toString(); // derniers items: code, expé, réseau MyCode := FDocTopo.GetLastCode(); MyExpe := FDocTopo.GetLastExpe(); editCurrNumeroExpe.AsInteger := MyExpe.IDExpe; editCurrNumeroCode.AsInteger := MyCode.IDCode; editCurrNumeroReseau.AsInteger := FDocTopo.NbReseaux - 1; editSQLFilename.InitialDir := GetGHTopoDirectory(); editSQLFilename.FileName := 'SQLExport001.sql'; chkDoEntrances.Checked := True; chkDoReseaux.Checked := True; chkDoCodes.Checked := false; chkDoSeances.Checked := false; // LRUD par défaut pour réattribution {$IFDEF USER_JP_CASSOU} // Carrières = 3 x 2 m par défaut editDefaultL.Value := 1.50; editDefaultR.Value := 1.50; editDefaultU.Value := 1.65; editDefaultD.Value := 0.35; // hauteur d'un cône de football {$ELSE} // A définir selon utilisateurs editDefaultL.Value := 1.50; editDefaultR.Value := 1.50; editDefaultU.Value := 1.65; editDefaultD.Value := 0.35; // hauteur d'un cône de football {$ENDIF} result := True; finally end; end; procedure TdlgMaintenanceDocTopo.ReprojeterLesEntrees(const OldEPSG, NewEPSG: TLabelSystemesCoordsEPSG); var EWE: String; Nb, i: Integer; MyEntrance: TEntrance; SrcPoint, DestPoint: TProjUV; begin EWE := Format('%s.ReprojeterLesEntrees: EPSG:%d -> EPSG:%d', [ClassName, OldEPSG.CodeEPSG, NewEPSG.CodeEPSG]); AfficherMessage(EWE); Nb := FDocTopo.NbEntrances; for i := 0 to Nb - 1 do begin MyEntrance := FDocTopo.GetEntrance(i); SrcPoint.U := MyEntrance.ePosition.X; SrcPoint.V := MyEntrance.ePosition.Y; DestPoint := FConvertisseurCoords.ConversionSyst1ToSyst2ByCodeEPSG(OldEPSG.CodeEPSG, NewEPSG.CodeEPSG, SrcPoint); MyEntrance.ePosition.X := DestPoint.U; MyEntrance.ePosition.Y := DestPoint.V; FDocTopo.PutEntrance(i, MyEntrance); end; // et on redéfinit le point zéro MyEntrance := FDocTopo.GetEntrance(0); FDocTopo.SetRefSeriePoint(MyEntrance.eRefSer, MyEntrance.eRefSt); FDocTopo.SetDefaultCoords(MyEntrance.ePosition.X, MyEntrance.ePosition.Y, MyEntrance.ePosition.Z); end; procedure TdlgMaintenanceDocTopo.Finaliser(); begin pass; end; function TdlgMaintenanceDocTopo.DoPostAction(const BoolDummy: boolean): boolean; begin result := FDoPostAction; end; end.