//{$INCLUDE DocDessinExportToSVG.inc} // Ce fichier est une dépendance de UnitDocDessin.pas function TDocumentDessin.ExportToSVG(const MyFileName: TStringDirectoryFileName; const ExportScrapsOnly: boolean; const DoXHTML: boolean; const QTitre, QDesc: string): boolean; const STYLE_DEFAULT_SILHOUETTE = 'DefaultSilhouette'; var MySVGCanvas: TSVGCanvas; // export d'un objet poncxtuel procedure ExporterObjectPonctuel(const OP: TSymbole); const R = 0.06; var BP: TBaseStation; GP: TGroupeEntites; PM: TPoint2Df; begin // TODO: Objets ponctuels GP := GetGroupeByIDGroupe(OP.IDGroupe); // groupe if (GetBasePointByIndex(OP.IDBaseStation, BP)) then begin PM.setFrom(BP.PosStation.X + OP.Offset.X, BP.PosStation.Y + OP.Offset.Y); case OP.TypeObject of nosPHOTO : MySVGCanvas.DrawImage(OP.TagTexte, PM.X, PM.Y, OP.ScaleX, OP.ScaleY); nosPOINT_TOPO : MySVGCanvas.DrawSymbole('symbStation', BP.PosStation.X - R, BP.PosStation.Y - R, 2*R, 2*R, 0.00); nosCORRESPONDANCE : if (not GP.DecalageActif) then Exit; else pass; end; end; end; // dessin d'un texte procedure ExporterTexte(const T: TTextObject); var S : string; ST: TStyleTexte; BP: TBaseStation; GP: TGroupeEntites; PM: TPoint2Df; begin ST := GetStyleTexte(Ord(T.IDStyleTexte)); // style GP := GetGroupeByIDGroupe(T.IDGroupe); // groupe if (GetBasePointByIndex(T.IDBaseStation, BP)) then begin if (BP.IsStationTopo()) then PM.setFrom(BP.PosStation.X + T.Offset.X, BP.PosStation.Y + T.Offset.Y) else PM.setFrom(T.Offset.X, T.Offset.Y); S :=InterpreterTexteAnnotation(T.Text, T.MaxLength, BP); MySVGCanvas.DrawTexte(ST.NameSVGStyle, T.Alignment, PM.X, PM.Y, 0.00, S); end; end; // dessin d'un polygone procedure ExporterPolygone(const QP: TPolygone); var QC: TArrayPoints2Df; ST: TStylePolygone; i, Nb: Integer; begin ST := GetStylePolygone(Ord(QP.IDStylePolygone)); AfficherMessage(Format('ExporterPolygone: %d',[QP.IDGroupe])); if (ConvertirGHCD2StdPolygon(QP.Sommets, QC)) then begin Nb := length(QC); if (0 = NB) then exit; MySVGCanvas.BeginListeVertex(); for i := 0 to Nb - 1 do MySVGCanvas.AddVertex(QC[i].X, QC[i].Y); MySVGCanvas.EndListeVertex(); MySVGCanvas.DrawPolygon(ST.NameSVGStyle, false); end; end; // dessin d'une polyligne procedure ExporterPolyligne(const QP: TPolyLigne); var ST: TStyleCourbe; QC: TArrayPoints2Df; Nb, i: Integer; begin ST := GetStyleCourbe(Ord(QP.IDStylePolyLine)); AfficherMessage(Format('ExporterPolyligne: %d',[QP.IDGroupe])); if (ConvertirGHCD2StdPolygon(QP.Sommets, QC)) then begin Nb := length(QC); if (0 = NB) then exit; MySVGCanvas.BeginListeVertex(); for i := 0 to Nb - 1 do MySVGCanvas.AddVertex(QC[i].X, QC[i].Y); MySVGCanvas.EndListeVertex(); MySVGCanvas.DrawPolylign(ST.NameSVGStyle, false); end; end; // dessin d'une ligne simple procedure ExporterSimpleLigne(const SL: TSimpleLigne); var BS1, BS2 : TBaseStation; PPP1, PPP2: TPoint2Df; begin if (GetBasePointByIndex(SL.IDBaseStExt1, BS1) AND GetBasePointByIndex(SL.IDBaseStExt2, BS2)) then begin PPP1.setFrom(BS1.PosStation.X + SL.OffsetExtr1.X, BS1.PosStation.Y + SL.OffsetExtr1.Y); PPP2.setFrom(BS2.PosStation.X + SL.OffsetExtr2.X, BS2.PosStation.Y + SL.OffsetExtr2.Y); end; end; // dessin d'une courbe procedure ExporterCourbe(const C: TCourbe); var ST: TStyleCourbe; i, NbArcs: Integer; A: TArcCourbe; BS1, BS2: TBaseStation; PP1, PP2, PP3, PP4: TPoint2Df; WU: String; begin ST := GetStyleCourbe(Ord(C.IDStyleCourbe)); AfficherMessageErreur(Format('ExporterCourbe: %d',[C.IDGroupe])); MySVGCanvas.BeginListeBezierArcs(); NbArcs := C.getNbArcs(); //Length(C.Arcs); for i := 0 to NbArcs - 1 do begin A := C.getArc(i); //C.Arcs[i]; if (GetBasePointByIndex(A.IDStationP1, BS1) AND GetBasePointByIndex(A.IDStationP2, BS2)) then begin PP1.setFrom(BS1.PosStation.X + A.OffsetP1.X, BS1.PosStation.Y + A.OffsetP1.Y); PP2.setFrom(BS1.PosStation.X + A.OffsetP1.X + A.TangP1.X, BS1.PosStation.Y + A.OffsetP1.Y + A.TangP1.Y); PP3.setFrom(BS2.PosStation.X + A.OffsetP2.X + A.TangP2.X, BS2.PosStation.Y + A.OffsetP2.Y + A.TangP2.Y); PP4.setFrom(BS2.PosStation.X + A.OffsetP2.X, BS2.PosStation.Y + A.OffsetP2.Y); MySVGCanvas.AddBezierArc(PP1.X, PP1.Y, PP2.X, PP2.Y, PP3.X, PP3.Y, PP4.X, PP4.Y); end; end; MySVGCanvas.EndListeBezierArcs(); MySVGCanvas.DrawBezierCurve(ST.NameSVGStyle, False); WU := MySVGCanvas.GetLastError(); end; // dessin d'un scrap procedure ExporterScrap(const SC: TScrap; const QIdx: integer); var QC: TArrayPoints2Df; Nb, i: Integer; begin AfficherMessage(Format('ExporterScrap: %d',[QIdx])); if (ConvertirGHCD2StdPolygon(SC.Sommets, QC)) then begin Nb := length(QC); if (0 = NB) then exit; MySVGCanvas.BeginListeVertex(); for i := 0 to Nb - 1 do MySVGCanvas.AddVertex(QC[i].X, QC[i].Y); MySVGCanvas.EndListeVertex(); MySVGCanvas.DrawPolygon(Format('Scrap%d', [QIdx]), false); end; end; // balancer les feuilles de styles procedure ExporterFeuillesDeStyles(); const MOTIF_ARGILE = 'pat_clay'; MOTIF_BLOC = 'pat_bloc'; MOTIF_SABLE = 'pat_sand'; MOTIF_GALETS = 'pat_galets'; MOTIF_EBOULIS = 'pat_eboulis'; FORMAT_STYLE = ' .%s {stroke:%s; stroke-width:%s; fill:%s}'; var i : integer; Qc : TColor; FSL : TStyleLigne; FSC : TStyleCourbe; FST : TStyleTexte; FSP : TStylePolygone; FSS : TStyleSymboles; Nb: Integer; MyScrap: TScrap; begin // motifs de remplissages MySVGCanvas.WriteCommentaire('** Styles de remplissages **'); MySVGCanvas.WriteCommand(''); // motifs // // // MySVGCanvas.WriteVerbatimLine(Format(' ', ['MyPattern'])); MySVGCanvas.WriteVerbatimLine(' '); MySVGCanvas.WriteCommand(''); //----------------------------------------------------- MySVGCanvas.WriteCommand(''); MySVGCanvas.WriteCommand(''); MySVGCanvas.WriteCommand(''); //MySVGCanvas.WriteCommentaire('---------------------------'); end; // balancer la table des symboles procedure ExporterTableSymboles(); begin // TODO: Compléter la table des symboles MySVGCanvas.WriteCommentaire('Table des symboles'); // Point topo MySVGCanvas.WriteVerbatimLine(' '); MySVGCanvas.WriteVerbatimLine(Format(' ', [SVG_NAME_MARQUE_STATION_CENTREFILL])); MySVGCanvas.WriteVerbatimLine(' '); MySVGCanvas.WriteCommentaire('Fin de la table des symboles'); end; // balancer le cadre de dessin procedure ExporterCadreDessin(); const GRP_CADRE_NAME = 'CadreGeneral'; MARGE_CADRE = 2.00; begin MySVGCanvas.BeginGroupe(GRP_CADRE_NAME, 'Cadre perimetrique du dessin', 0.00, 0.00); //MySVGCanvas.SetPen(Crayon); MySVGCanvas.DrawRectangle(SVG_NAME_CADRE_PERIMETRIQUE, FCoordsMini.X + MARGE_CADRE, FCoordsMini.Y + MARGE_CADRE, FCoordsMaxi.X - MARGE_CADRE, FCoordsMaxi.Y - MARGE_CADRE); MySVGCanvas.DrawRectangle(SVG_NAME_CADRE_MASSICOT, FCoordsMini.X + 0.5, FCoordsMini.Y + 0.5, FCoordsMaxi.X - 0.5, FCoordsMaxi.Y - 0.5); MySVGCanvas.EndGroupe(GRP_CADRE_NAME); end; // balancer la polygonale procedure ExporterPolygonale(); const GRP_POLYGONALS = 'Polygonales'; var i : integer; BS : TBaseStation; begin if (ExportScrapsOnly) then Exit; // en scraps seuls, ne rien faire MySVGCanvas.BeginGroupe(GRP_POLYGONALS, 'Squelette topo polygonal', 0.00, 0.00); // polygonales for i := 0 to FCenterLines.GetNbBasePoints() do begin BS := FCenterLines.GetBasePoint(i); if (BS.TypeStation = 1) then Continue; MySVGCanvas.DrawLine(SVG_NAME_POLYGONALE_CENTERLINE, BS.PosExtr0.X, BS.PosExtr0.Y, BS.PosStation.X, BS.PosStation.Y); end; // sections for i := 0 to FCenterLines.GetNbBasePoints() do begin BS := FCenterLines.GetBasePoint(i); if (BS.TypeStation = 7) then Continue; MySVGCanvas.DrawLine(SVG_NAME_POLYGONALE_SECTIONS, BS.PosPG.X, BS.PosPG.Y, BS.PosPD.X, BS.PosPD.Y); end; MySVGCanvas.EndGroupe(GRP_POLYGONALS); end; // balancer les groupes procedure ExporterGroupes(); var NoGrp : integer; NoObjet : integer; QGroupe : TGroupeEntites; QCourbe : TCourbe; QTexte : TTextObject; QPolygon : TPolygone; QPonctObjet : TSymbole; QPolyligne: TPolyLigne; Nb: Integer; NbObj: Integer; QScrap: TScrap; QDecalage: TPoint3Df; QSimpleligne: TSimpleLigne; begin Nb := GetNbGroupes(); for NoGrp := 0 to Nb - 1 do begin QGroupe := GetGroupe(NoGrp); // balise de début de groupe if (QGroupe.DecalageActif) then QDecalage := QGroupe.Decalage else QDecalage.Empty(); MySVGCanvas.BeginGroupe(Format('Groupe_%d',[QGroupe.IDGroupeEntites]), QGroupe.NomGroupe, QDecalage.X, QDecalage.Y); // scraps NbObj := GetNbScraps(); if (NbObj > 0) then begin for NoObjet := 0 to NbObj - 1 do begin QScrap := GetScrap(NoObjet); if (QScrap.IDGroupe = QGroupe.IDGroupeEntites) then ExporterScrap(QScrap, NoObjet); end; end; // si on a choisi d'exporter les scraps seuls, on passe au groupe suivant if (not ExportScrapsOnly) then begin // polygones (en premier) NbObj := GetNbPolygones(); if (NbObj > 0) then begin for NoObjet := 0 to NbObj - 1 do begin QPolygon := GetPolygone(NoObjet); if (QPolygon.IDGroupe = QGroupe.IDGroupeEntites) then ExporterPolygone(QPolygon); end; end; // courbes NbObj := GetNbCourbes(); if (NbObj > 0) then begin for NoObjet := 0 to NbObj - 1 do begin QCourbe := GetCourbe(NoObjet); if (QCourbe.IDGroupe = QGroupe.IDGroupeEntites) then ExporterCourbe(QCourbe); end; end; //Polylignes NbObj := GetNbPolylignes(); if (NbObj > 0) then begin for NoObjet := 0 to NbObj - 1 do begin QPolyligne := GetPolyligne(NoObjet); if (QPolyligne.IDGroupe = QGroupe.IDGroupeEntites) then ExporterPolyligne(QPolyligne); end; end; // Lignes simples NbObj := GetNbSimpleLignes(); if (NbObj > 0) then begin for NoObjet := 0 to NbObj - 1 do begin QSimpleligne := GetSimpleLigne(NoObjet); if (QPolyligne.IDGroupe = QGroupe.IDGroupeEntites) then ExporterSimpleLigne(QSimpleligne); end; end; // objets ponctuels NbObj := GetNbSymboles(); if (NbObj > 0) then begin for NoObjet := 0 to NbObj - 1 do begin QPonctObjet := GetSymbole(NoObjet); if (QPonctObjet.IDGroupe = QGroupe.IDGroupeEntites) then ExporterObjectPonctuel(QPonctObjet); end; end; // textes NbObj := GetNbTextes(); if (NbObj > 0) then begin for NoObjet := 0 to NbObj - 1 do begin QTexte := GetTexte(NoObjet); if (QTexte.IDGroupe = QGroupe.IDGroupeEntites) then ExporterTexte(QTexte); end; end; end; // if (not ExportScrapsOnly) then // balise de fin de groupe MySVGCanvas.EndGroupe(Format('Groupe_%d',[QGroupe.IDGroupeEntites])); end; end; procedure DessinCartouche(); const MARGE_CADRE = 3.00; procedure DessinEchelle(const QX, QY, L, H: double); const SD = 10; var HL, HH: double; FX1, FY1, FX2, FY2: Double; i, EWE: Integer; begin AfficherMessage('-------- DessinEchelle'); HH := H / 2; HL := L / SD; MySVGCanvas.BeginGroupe(GROUPE_ECHELLE, 'Echelle', 0.00, 0.00); MySVGCanvas.DrawRectangle(SVG_NAME_CARTOUCHE_REGLE_CADRE, QX, QY, QX + L, QY + H); for i := 0 to SD -1 do begin EWE := IIF(Odd(i), 0, 1); MySVGCanvas.DrawRectangle(SVG_NAME_CARTOUCHE_REGLE_GRADU, QX + i * HL, QY + EWE * HH, QX + (i+1) * HL, QY + (EWE + 1) * HH); end; MySVGCanvas.EndGroupe(GROUPE_ECHELLE); end; begin AfficherMessage('---- DessinCartouche'); MySVGCanvas.BeginGroupe(GROUPE_CARTOUCHE, '', 0.00, 0.00); DessinEchelle(FCoordsMini.X + MARGE_CADRE, FCoordsMini.Y + MARGE_CADRE, 50.00, 02.00); MySVGCanvas.EndGroupe(GROUPE_CARTOUCHE); end; begin Result := False; AfficherMessage(Format('%s.ExportToSVG: %s - %s - %s %s',[self.ClassName, MyFileName, BoolToStr(DoXHTML, 'XHTML', 'SVG'), QTitre, QDesc])); MySVGCanvas := TSVGCanvas.Create; try if (not MySVGCanvas.InitializeDocument(MyFileName, false, QTitre, QDesc, FCoordsMini.X, FCoordsMini.Y, FCoordsMaxi.X, FCoordsMaxi.Y, nil)) then exit; MySVGCanvas.BeginDrawingSection(); //--------------------------------------------- // le dessin ici //--------------------------------------------- AfficherMessage('--> Feuilles de styles internes'); ExporterFeuillesDeStyles(); AfficherMessage('--> Table des symboles'); ExporterTableSymboles(); AfficherMessage('--> Cadre périmétrique'); ExporterCadreDessin(); AfficherMessage('--> Cartouche'); DessinCartouche(); AfficherMessage('--> Polygonales'); ExporterPolygonale(); AfficherMessage('--> Export Groupes'); ExporterGroupes(); //--------------------------------------------- MySVGCanvas.EndDrawingSection(); // finalisation MySVGCanvas.FinalizeDocument(); Result := True; finally MySVGCanvas.Free; end; end;