Простой векторный 2D редактор для черчения

Обсуждаются как существующие проекты (перевод документации, информационная система и т.п.), так и создание новых.

Модератор: Модераторы

Аватара пользователя
Sharfik
энтузиаст
Сообщения: 841
Зарегистрирован: 20.07.2013 01:04:30

Сообщение Sharfik »

А что будет делать конечный инструмент? Вижу ГИС картинки.

PS^ Inkscape может помочь сделать приличные кнопки.
Alex2013
долгожитель
Сообщения: 3248
Зарегистрирован: 03.04.2013 11:59:44

Сообщение Alex2013 »

Решил не мудрствовать и добавил сначала индикацию состояния кнопок модификаторов и текущего инструмента и посмотрев на это безобразие (состояние Ctrl Alt и Shift действительно ингода "залипает" ) Сделал явный показ списка фигур
Изображение
(И само собой теперь можно кликом по списку ставить и снимать выделение )
Дополнение вполне работает но нужно "навести блеск" в разных мелочах.

Добавлено спустя 5 часов 40 минут 31 секунду:
Sharfik писал(а):А что будет делать конечный инструмент? Вижу ГИС картинки.
Вообщем все это часть проекта среды для "поддержки мозгового штурма " и создания презентаций на около-мелиорационные темы (Задача обеспечить наглядный выбор вариантов для фермеров, агрономов, руководителей мелиоративных объектов и т.п. - по сути продвинутый вариант инфографики с данными схемами и гис-привязкой (возможно на следующем этапе будет расчетный болк,таблицы, генератор отсчетов и т.п. но пока задача создать эффектную продвинутую (с опорой на реальные разработки ) и наглядную "показуху" некого "наукоемкого процесса".))

Пока что есть что-такое...
Изображение
1 По центру и справа "настоящая ГИС " ( на основе общедоступных интернет сервисов )
2 Слева простой "редактор структурных диаграмм" (тоже векторный но значительно более примитивный )...
3 Сверху панель управления и интеграции + инструментарий для создания презентаций .

А вот снизу будет "промежуточное звено" простой векторный 2D редактор для черчения.
(По сути "векторный блокнот" для упрощенного черчения (возможно частично поверх ГИС карт или упрощенных понятных схем с привязкой к местности ))
Зы
Извиняюсь что не ответил сразу ! ( Не заметили переход на новую станицу форума )
Alex2013
долгожитель
Сообщения: 3248
Зарегистрирован: 03.04.2013 11:59:44

Сообщение Alex2013 »

Тут у меня очедная "вынужденная передислокация" из "темного царства ангины" (Киева) почти отогрелся и постепенно обустраиваюсь.
Надеюсь что скоро выложу очередную сборку .
Alex2013
долгожитель
Сообщения: 3248
Зарегистрирован: 03.04.2013 11:59:44

Сообщение Alex2013 »

Изображение
И так обещанная свежая сборка (на самом деле тестовых сборок было уже несколько но эта более менее полезная и стабильная)

>>>>Min_VGED_BIN_B_0_04_579_7.7z
>>>>Min_VGED_SRC_B_0_04_579_7.7z

Добавил список фигур(можно снимать и устанавливать выделение в "ручном режиме"), удобное переключение режимов "прямого выбора фигур"(немного недоделано но добавление списка и "ручного режима " снимает большую часть возможных проблем ) и скроллбар в панели инструментов
Последний раз редактировалось Alex2013 17.02.2026 19:55:47, всего редактировалось 2 раза.
Аватара пользователя
Alexander
энтузиаст
Сообщения: 891
Зарегистрирован: 18.12.2005 18:10:00
Откуда: оттуда
Контактная информация:

Сообщение Alexander »

Спасибо!
Alex2013
долгожитель
Сообщения: 3248
Зарегистрирован: 03.04.2013 11:59:44

Сообщение Alex2013 »

Пожалуйста ! :idea: (надеюсь на помощь в тестировании)
Зы
В бинарник включил тестовые изображения. ( "избранная халтура" :wink: )
Alex2013
долгожитель
Сообщения: 3248
Зарегистрирован: 03.04.2013 11:59:44

Сообщение Alex2013 »

Первая версия конвертера svg2ged (ged формат записи моего редактора )
( Еще не отлаживал что-то так что может содержать ошибки и частично не работать )

1 Поддерживаемые элементы SVG:
<rect> → TRectangle (или TRoundRectangle если есть rx/ry)
<circle> → TEllipse
<ellipse> → TEllipse
<line> → TLine
<polyline> → TPolyLine
<polygon> → TPolygon
<text> → TText

2 Поддержка стилей:
Цвета (RGB и HEX)
Толщина линий
Стили штрихов
Заливки
Трансформации (translate)

3 Ограничения:
Не поддерживаются сложные пути <path>
Не поддерживаются градиенты
Не поддерживаются маски и фильтры

Код: Выделить всё

Нерабочий код выкинул ...
Последний раз редактировалось Alex2013 21.02.2026 17:19:16, всего редактировалось 1 раз.
Alex2013
долгожитель
Сообщения: 3248
Зарегистрирован: 03.04.2013 11:59:44

Сообщение Alex2013 »

Слегка исправленная версия конвертера svg2ged (собирается и немного работает )
ДОПОЛНЕНИЕ
Обновленный конвертер svg2ged ( теперь с поддерживает path причем довольно полно )

Код: Выделить всё

program svg2ged;

{$mode objfpc}{$H+}

uses
  Classes, SysUtils, DOM, XMLRead, fpjson,
  Math, Graphics;

type
  TDPoint = record
    x, y: double;
  end;
  TDPointArray = array of TDPoint;  // Динамический массив точек

  TFigureData = record
    ClassName: string;
    Points: TDPointArray;  // Используем динамический массив
    PenColor: Integer;
    PenWidth: Integer;
    PenStyle: Integer;  // 0..5
    BrushColor: Integer;
    BrushStyle: Integer; // 0..7
    Rounding: Integer;
    Text: string;
    FontName: string;
    FontSize: Integer;
  end;

  TFiguresArray = array of TFigureData;

// Вспомогательная функция для безопасного получения значения атрибута
function GetAttrValue(Node: TDOMNode; const AttrName: string): string;
var
  Attr: TDOMNode;
begin
  Result := '';
  if Node = nil then Exit;

  Attr := Node.Attributes.GetNamedItem(AttrName);
  if Attr <> nil then
    Result := Attr.NodeValue;
end;

function ColorToInt(const AColor: string): Integer;
var
  R, G, B: Integer;
  Temp: string;
begin
  Result := clBlack; // цвет по умолчанию

  if AColor = '' then Exit;

  // transparent означает прозрачный, но для цвета вернем clNone или clBlack
  if AColor = 'transparent' then
  begin
    Result := clNone; // или можно оставить clBlack, если clNone не поддерживается
    Exit;
  end;

  // Парсим rgb(r,g,b)
  if Pos('rgb', LowerCase(AColor)) = 1 then
  begin
    Temp := Copy(AColor, 5, Length(AColor) - 5);
    R := StrToIntDef(Trim(Copy(Temp, 1, Pos(',', Temp) - 1)), 0);
    Delete(Temp, 1, Pos(',', Temp));
    G := StrToIntDef(Trim(Copy(Temp, 1, Pos(',', Temp) - 1)), 0);
    Delete(Temp, 1, Pos(',', Temp));
    B := StrToIntDef(Trim(Temp), 0);
    Result := RGBToColor(R, G, B);
  end
  // Парсим hex #RRGGBB
  else if Pos('#', AColor) = 1 then
  begin
    Temp := Copy(AColor, 2, 6);
    if Length(Temp) = 6 then
    begin
      R := StrToIntDef('$' + Copy(Temp, 1, 2), 0);
      G := StrToIntDef('$' + Copy(Temp, 3, 2), 0);
      B := StrToIntDef('$' + Copy(Temp, 5, 2), 0);
      Result := RGBToColor(R, G, B);
    end;
  end
  // Парсим именованные цвета
  else if AColor = 'black' then Result := clBlack
  else if AColor = 'white' then Result := clWhite
  else if AColor = 'red' then Result := clRed
  else if AColor = 'green' then Result := clGreen
  else if AColor = 'blue' then Result := clBlue
  else if AColor = 'yellow' then Result := clYellow
  else if AColor = 'gray' then Result := clGray
  else if AColor = 'silver' then Result := clSilver
  else if AColor = 'maroon' then Result := clMaroon
  else if AColor = 'purple' then Result := clPurple
  else if AColor = 'fuchsia' then Result := clFuchsia
  else if AColor = 'lime' then Result := clLime
  else if AColor = 'olive' then Result := clOlive
  else if AColor = 'navy' then Result := clNavy
  else if AColor = 'teal' then Result := clTeal
  else if AColor = 'aqua' then Result := clAqua;
end;

function ParseStrokeStyle(const AStrokeDashArray: string): Integer;
begin
  Result := 0; // psSolid по умолчанию

  if AStrokeDashArray = '' then Exit;

  if Pos('none', LowerCase(AStrokeDashArray)) > 0 then
    Result := 1 // psClear
  else if Pos('dash', LowerCase(AStrokeDashArray)) > 0 then
  begin
    if Pos('dot', LowerCase(AStrokeDashArray)) > 0 then
    begin
      if Pos('dot dot', LowerCase(AStrokeDashArray)) > 0 then
        Result := 5 // psDashDotDot
      else
        Result := 4; // psDashDot
    end
    else
      Result := 3; // psDash
  end
  else if Pos('dot', LowerCase(AStrokeDashArray)) > 0 then
    Result := 2; // psDot
end;

function ParseFillStyle(const AFill: string): Integer;
begin
  Result := 1; // bsClear по умолчанию

  if AFill = '' then Exit;

  // Проверяем на "none" или "transparent" - оба означают отсутствие заливки
  if (AFill = 'none') or (AFill = 'transparent') then
    Result := 1 // bsClear
  else
    Result := 0; // Если есть цвет - Solid
end;

procedure ParseTransform(const ATransform: string; out TX, TY: Double);
var
  Temp: string;
  P: Integer;
begin
  TX := 0; TY := 0;
  if ATransform = '' then Exit;

  Temp := LowerCase(ATransform);
  P := Pos('translate(', Temp);
  if P > 0 then
  begin
    Temp := Copy(Temp, P + 10, Length(Temp));
    P := Pos(')', Temp);
    if P > 0 then
    begin
      Temp := Copy(Temp, 1, P - 1);
      P := Pos(',', Temp);
      if P > 0 then
      begin
        TX := StrToFloatDef(Trim(Copy(Temp, 1, P - 1)), 0);
        TY := StrToFloatDef(Trim(Copy(Temp, P + 1, Length(Temp))), 0);
      end
      else
        TX := StrToFloatDef(Trim(Temp), 0);
    end;
  end;
end;

// Функция парсинга SVG path
procedure ParsePathData(const PathData: string; var Points: TDPointArray; IsPolygon: Boolean);
var
  S: string;
  i, j: Integer;
  Tokens: TStringList;
  Token: string;
  LastCmd: Char;
  CurrentX, CurrentY: Double;
  StartX, StartY: Double;
  ControlX, ControlY: Double;
  TempX, TempY: Double;
  Cmd: Char;
  Absolute: Boolean;
  ExpectedParams: Integer;
  Params: array[0..6] of Double;
  ParamIndex: Integer;
  PointCount: Integer;
  
  // Процедура добавления точки
  procedure AddPoint(X, Y: Double);
  begin
    if PointCount >= Length(Points) then
      SetLength(Points, Length(Points) + 100);
    Points[PointCount].x := X;
    Points[PointCount].y := Y;
    Inc(PointCount);
  end;
  
  function IsCommand(ch: Char): Boolean;
  begin
    Result := ch in ['A'..'Z', 'a'..'z'];
  end;
  
  function ParseNextNumber(var Pos: Integer; const Str: String; out Value: Double): Boolean;
  var
    StartPos: Integer;
    NumStr: String;
  begin
    Result := False;
    // Пропускаем пробелы и запятые
    while (Pos <= Length(Str)) and (Str[Pos] in [' ', ',', #9, #10, #13]) do
      Inc(Pos);
    
    if Pos > Length(Str) then Exit;
    
    StartPos := Pos;
    
    // Парсим число (может начинаться с -, +, . или цифры)
    if Str[Pos] in ['-', '+', '.', '0'..'9'] then
    begin
      Inc(Pos);
      // Читаем цифры, точку, экспоненту
      while (Pos <= Length(Str)) and 
            (Str[Pos] in ['0'..'9', '.', 'e', 'E', '-', '+']) and
            not (Str[Pos] in ['A'..'Z', 'a'..'z']) do
      begin
        // Не даем команде прервать число
        if IsCommand(Str[Pos]) then Break;
        Inc(Pos);
      end;
      
      NumStr := Copy(Str, StartPos, Pos - StartPos);
      Value := StrToFloatDef(NumStr, 0);
      Result := True;
    end;
  end;
  
begin
  // Инициализация
  SetLength(Points, 0);
  PointCount := 0;
  
  if PathData = '' then Exit;
  
  S := PathData;
  i := 1; // позиция в строке
  CurrentX := 0;
  CurrentY := 0;
  StartX := 0;
  StartY := 0;
  ControlX := 0;
  ControlY := 0;
  LastCmd := #0;
  ParamIndex := 0;
  ExpectedParams := 0;
  
  while i <= Length(S) do
  begin
    // Пропускаем пробелы и запятые
    while (i <= Length(S)) and (S[i] in [' ', ',', #9, #10, #13]) do
      Inc(i);
    
    if i > Length(S) then Break;
    
    // Проверяем, является ли текущий символ командой
    if IsCommand(S[i]) then
    begin
      Cmd := S[i];
      Absolute := (Cmd >= 'A') and (Cmd <= 'Z');
      LastCmd := Cmd;
      Inc(i);
      
      // Определяем ожидаемое количество параметров для команды
      case UpCase(Cmd) of
        'M', 'L', 'T': ExpectedParams := 2;
        'H', 'V': ExpectedParams := 1;
        'C': ExpectedParams := 6;
        'S', 'Q': ExpectedParams := 4;
        'A': ExpectedParams := 7;
        'Z': ExpectedParams := 0;
        else ExpectedParams := 0;
      end;
      
      ParamIndex := 0;
    end;
    
    // Если нет активной команды, пропускаем
    if LastCmd = #0 then
    begin
      Inc(i);
      Continue;
    end;
    
    // Читаем параметры для текущей команды
    while (ParamIndex < ExpectedParams) and (i <= Length(S)) do
    begin
      if ParseNextNumber(i, S, Params[ParamIndex]) then
        Inc(ParamIndex)
      else
        Break;
    end;
    
    // Если собрали все параметры для текущей команды или команда без параметров
    if (ParamIndex = ExpectedParams) or (ExpectedParams = 0) then
    begin
      // Обрабатываем команду
      case UpCase(LastCmd) of
        'M': // MoveTo
          begin
            TempX := Params[0];
            TempY := Params[1];
            if not Absolute then
            begin
              TempX := CurrentX + TempX;
              TempY := CurrentY + TempY;
            end;
            StartX := TempX;
            StartY := TempY;
            CurrentX := TempX;
            CurrentY := TempY;
            AddPoint(CurrentX, CurrentY);
            
            // После M следующие пары координат обрабатываются как L
            if ExpectedParams > 0 then
              LastCmd := 'L';
          end;
          
        'L': // LineTo
          begin
            TempX := Params[0];
            TempY := Params[1];
            if not Absolute then
            begin
              TempX := CurrentX + TempX;
              TempY := CurrentY + TempY;
            end;
            CurrentX := TempX;
            CurrentY := TempY;
            AddPoint(CurrentX, CurrentY);
          end;
          
        'H': // Horizontal LineTo
          begin
            TempX := Params[0];
            if not Absolute then
              TempX := CurrentX + TempX;
            CurrentX := TempX;
            AddPoint(CurrentX, CurrentY);
          end;
          
        'V': // Vertical LineTo
          begin
            TempY := Params[0];
            if not Absolute then
              TempY := CurrentY + TempY;
            CurrentY := TempY;
            AddPoint(CurrentX, CurrentY);
          end;
          
        'C': // Cubic Bezier
          begin
            TempX := Params[4];
            TempY := Params[5];
            if not Absolute then
            begin
              TempX := CurrentX + TempX;
              TempY := CurrentY + TempY;
            end;
            CurrentX := TempX;
            CurrentY := TempY;
            AddPoint(CurrentX, CurrentY);
            
            ControlX := Params[2];
            ControlY := Params[3];
            if not Absolute then
            begin
              ControlX := CurrentX + ControlX;
              ControlY := CurrentY + ControlY;
            end;
          end;
          
        'S': // Smooth Cubic Bezier
          begin
            TempX := Params[2];
            TempY := Params[3];
            if not Absolute then
            begin
              TempX := CurrentX + TempX;
              TempY := CurrentY + TempY;
            end;
            CurrentX := TempX;
            CurrentY := TempY;
            AddPoint(CurrentX, CurrentY);
          end;
          
        'Q': // Quadratic Bezier
          begin
            TempX := Params[2];
            TempY := Params[3];
            if not Absolute then
            begin
              TempX := CurrentX + TempX;
              TempY := CurrentY + TempY;
            end;
            CurrentX := TempX;
            CurrentY := TempY;
            AddPoint(CurrentX, CurrentY);
          end;
          
        'A': // Arc
          begin
            TempX := Params[5];
            TempY := Params[6];
            if not Absolute then
            begin
              TempX := CurrentX + TempX;
              TempY := CurrentY + TempY;
            end;
            CurrentX := TempX;
            CurrentY := TempY;
            AddPoint(CurrentX, CurrentY);
          end;
          
        'Z': // ClosePath
          begin
            if IsPolygon and ((CurrentX <> StartX) or (CurrentY <> StartY)) then
            begin
              CurrentX := StartX;
              CurrentY := StartY;
              AddPoint(CurrentX, CurrentY);
            end;
          end;
      end;
      
      // Сбрасываем индекс параметров для следующей порции
      ParamIndex := 0;
      // Для команд, которые могут иметь несколько пар координат (M, L и т.д.)
      if UpCase(LastCmd) in ['M', 'L', 'C', 'S', 'Q', 'T'] then
      begin
        // Оставляем текущую команду активной для следующих параметров
        // (ничего не делаем)
      end
      else
      begin
        // Для остальных команд сбрасываем
        LastCmd := #0;
      end;
    end;
  end;
  
  // Обрезаем массив до реального размера
  SetLength(Points, PointCount);
end;
function SVGToGED(const ASVGFile: string): TFiguresArray;
var
  Doc: TXMLDocument;
  Node, Child: TDOMNode;
  i, j: Integer;
  Figure: TFigureData;
  Points: TStringList;
  PointStr, Temp: string;
  X, Y, TX, TY: Double;
  AttrValue: string;
  PathPoints: TDPointArray;
  FillType: string;
begin
  Result := nil;
  Points := TStringList.Create;
  try
    ReadXMLFile(Doc, ASVGFile);
    try
      Node := Doc.DocumentElement.FirstChild;
      while Assigned(Node) do
      begin
        if Node.NodeName = 'rect' then
        begin
          SetLength(Result, Length(Result) + 1);
          Figure.ClassName := 'TRectangle';
          SetLength(Figure.Points, 2);

          X := StrToFloatDef(GetAttrValue(Node, 'x'), 0);
          Y := StrToFloatDef(GetAttrValue(Node, 'y'), 0);

          Figure.Points[0].x := X;
          Figure.Points[0].y := Y;
          Figure.Points[1].x := X + StrToFloatDef(GetAttrValue(Node, 'width'), 100);
          Figure.Points[1].y := Y + StrToFloatDef(GetAttrValue(Node, 'height'), 100);

          Figure.PenColor := ColorToInt(GetAttrValue(Node, 'stroke'));
          Figure.PenWidth := StrToIntDef(GetAttrValue(Node, 'stroke-width'), 1);
          Figure.PenStyle := ParseStrokeStyle(GetAttrValue(Node, 'stroke-dasharray'));
          Figure.BrushColor := ColorToInt(GetAttrValue(Node, 'fill'));
          Figure.BrushStyle := ParseFillStyle(GetAttrValue(Node, 'fill'));

          // Проверяем на скругленный прямоугольник
          AttrValue := GetAttrValue(Node, 'rx');
          if AttrValue <> '' then
          begin
            Figure.ClassName := 'TRoundRectangle';
            Figure.Rounding := StrToIntDef(AttrValue, 10);
          end;

          Result[High(Result)] := Figure;
        end
        else if Node.NodeName = 'circle' then
        begin
          SetLength(Result, Length(Result) + 1);
          Figure.ClassName := 'TEllipse';
          SetLength(Figure.Points, 2);

          X := StrToFloatDef(GetAttrValue(Node, 'cx'), 0);
          Y := StrToFloatDef(GetAttrValue(Node, 'cy'), 0);
          Temp := GetAttrValue(Node, 'r');

          Figure.Points[0].x := X - StrToFloatDef(Temp, 50);
          Figure.Points[0].y := Y - StrToFloatDef(Temp, 50);
          Figure.Points[1].x := X + StrToFloatDef(Temp, 50);
          Figure.Points[1].y := Y + StrToFloatDef(Temp, 50);

          Figure.PenColor := ColorToInt(GetAttrValue(Node, 'stroke'));
          Figure.PenWidth := StrToIntDef(GetAttrValue(Node, 'stroke-width'), 1);
          Figure.PenStyle := ParseStrokeStyle(GetAttrValue(Node, 'stroke-dasharray'));
          Figure.BrushColor := ColorToInt(GetAttrValue(Node, 'fill'));
          Figure.BrushStyle := ParseFillStyle(GetAttrValue(Node, 'fill'));

          Result[High(Result)] := Figure;
        end
        else if Node.NodeName = 'ellipse' then
        begin
          SetLength(Result, Length(Result) + 1);
          Figure.ClassName := 'TEllipse';
          SetLength(Figure.Points, 2);

          X := StrToFloatDef(GetAttrValue(Node, 'cx'), 0);
          Y := StrToFloatDef(GetAttrValue(Node, 'cy'), 0);

          Figure.Points[0].x := X - StrToFloatDef(GetAttrValue(Node, 'rx'), 50);
          Figure.Points[0].y := Y - StrToFloatDef(GetAttrValue(Node, 'ry'), 50);
          Figure.Points[1].x := X + StrToFloatDef(GetAttrValue(Node, 'rx'), 50);
          Figure.Points[1].y := Y + StrToFloatDef(GetAttrValue(Node, 'ry'), 50);

          Figure.PenColor := ColorToInt(GetAttrValue(Node, 'stroke'));
          Figure.PenWidth := StrToIntDef(GetAttrValue(Node, 'stroke-width'), 1);
          Figure.PenStyle := ParseStrokeStyle(GetAttrValue(Node, 'stroke-dasharray'));
          Figure.BrushColor := ColorToInt(GetAttrValue(Node, 'fill'));
          Figure.BrushStyle := ParseFillStyle(GetAttrValue(Node, 'fill'));

          Result[High(Result)] := Figure;
        end
        else if Node.NodeName = 'line' then
        begin
          SetLength(Result, Length(Result) + 1);
          Figure.ClassName := 'TLine';
          SetLength(Figure.Points, 2);

          Figure.Points[0].x := StrToFloatDef(GetAttrValue(Node, 'x1'), 0);
          Figure.Points[0].y := StrToFloatDef(GetAttrValue(Node, 'y1'), 0);
          Figure.Points[1].x := StrToFloatDef(GetAttrValue(Node, 'x2'), 100);
          Figure.Points[1].y := StrToFloatDef(GetAttrValue(Node, 'y2'), 100);

          Figure.PenColor := ColorToInt(GetAttrValue(Node, 'stroke'));
          Figure.PenWidth := StrToIntDef(GetAttrValue(Node, 'stroke-width'), 1);
          Figure.PenStyle := ParseStrokeStyle(GetAttrValue(Node, 'stroke-dasharray'));
          Figure.BrushStyle := 1; // bsClear

          Result[High(Result)] := Figure;
        end
        else if (Node.NodeName = 'polyline') or (Node.NodeName = 'polygon') then
        begin
          SetLength(Result, Length(Result) + 1);

          if Node.NodeName = 'polyline' then
            Figure.ClassName := 'TPolyLine'
          else
            Figure.ClassName := 'TPolygon';

          Temp := GetAttrValue(Node, 'points');
          Points.Clear;

          // Простой парсинг точек
          Temp := StringReplace(Temp, ',', ' ', [rfReplaceAll]);
          Temp := StringReplace(Temp, '-', ' -', [rfReplaceAll]);
          Temp := Trim(Temp);

          while Pos('  ', Temp) > 0 do
            Temp := StringReplace(Temp, '  ', ' ', [rfReplaceAll]);

          Points.DelimitedText := Temp;

          SetLength(Figure.Points, Points.Count div 2);
          for j := 0 to (Points.Count div 2) - 1 do
          begin
            Figure.Points[j].x := StrToFloatDef(Points[j * 2], 0);
            Figure.Points[j].y := StrToFloatDef(Points[j * 2 + 1], 0);
          end;

          Figure.PenColor := ColorToInt(GetAttrValue(Node, 'stroke'));
          Figure.PenWidth := StrToIntDef(GetAttrValue(Node, 'stroke-width'), 1);
          Figure.PenStyle := ParseStrokeStyle(GetAttrValue(Node, 'stroke-dasharray'));
          Figure.BrushColor := ColorToInt(GetAttrValue(Node, 'fill'));
          Figure.BrushStyle := ParseFillStyle(GetAttrValue(Node, 'fill'));

          Result[High(Result)] := Figure;
        end
        else if Node.NodeName = 'text' then
        begin
          SetLength(Result, Length(Result) + 1);
          Figure.ClassName := 'TText';
          SetLength(Figure.Points, 1);

          Figure.Points[0].x := StrToFloatDef(GetAttrValue(Node, 'x'), 0);
          Figure.Points[0].y := StrToFloatDef(GetAttrValue(Node, 'y'), 0);

          // Применяем трансформацию
          ParseTransform(GetAttrValue(Node, 'transform'), TX, TY);
          Figure.Points[0].x := Figure.Points[0].x + TX;
          Figure.Points[0].y := Figure.Points[0].y + TY;

          // Получаем текст
          if Node.FirstChild <> nil then
            Figure.Text := Node.FirstChild.NodeValue;

          // Парсим стили
          Figure.PenColor := ColorToInt(GetAttrValue(Node, 'fill'));
          Figure.FontName := GetAttrValue(Node, 'font-family');
          if Figure.FontName = '' then
            Figure.FontName := 'Arial';

          AttrValue := GetAttrValue(Node, 'font-size');
          if AttrValue <> '' then
            Figure.FontSize := StrToIntDef(AttrValue, 12)
          else
            Figure.FontSize := 12;

          Figure.PenWidth := 1;
          Figure.BrushStyle := 1; // bsClear

          Result[High(Result)] := Figure;
        end
        else if Node.NodeName = 'path' then
        begin
   SetLength(Result, Length(Result) + 1);

  // Определяем тип фигуры по наличию заливки
  FillType := GetAttrValue(Node, 'fill');
  // Если fill="none" или fill="transparent" или fill отсутствует - делаем полилинию
  if (FillType = '') or (FillType = 'none') or (FillType = 'transparent') then
    Figure.ClassName := 'TPolyLine'
  else
    Figure.ClassName := 'TPolygon';

  // Парсим данные path
  Temp := GetAttrValue(Node, 'd');
  ParsePathData(Temp, PathPoints, Figure.ClassName = 'TPolygon');


          // Определяем тип фигуры по наличию заливки
          FillType := GetAttrValue(Node, 'fill');
          if (FillType <> '') and (FillType <> 'none') then
            Figure.ClassName := 'TPolygon'
          else
            Figure.ClassName := 'TPolyLine';


          // Копируем точки в фигуру
          SetLength(Figure.Points, Length(PathPoints));
          for j := 0 to Length(PathPoints) - 1 do
            Figure.Points[j] := PathPoints[j];

          // Применяем трансформацию, если есть
          ParseTransform(GetAttrValue(Node, 'transform'), TX, TY);
          if (TX <> 0) or (TY <> 0) then
          begin
            for j := 0 to Length(Figure.Points) - 1 do
            begin
              Figure.Points[j].x := Figure.Points[j].x + TX;
              Figure.Points[j].y := Figure.Points[j].y + TY;
            end;
          end;

          Figure.PenColor := ColorToInt(GetAttrValue(Node, 'stroke'));
          Figure.PenWidth := StrToIntDef(GetAttrValue(Node, 'stroke-width'), 1);
          Figure.PenStyle := ParseStrokeStyle(GetAttrValue(Node, 'stroke-dasharray'));
          Figure.BrushColor := ColorToInt(GetAttrValue(Node, 'fill'));
          Figure.BrushStyle := ParseFillStyle(GetAttrValue(Node, 'fill'));

          Result[High(Result)] := Figure;
        end;

        Node := Node.NextSibling;
      end;

    finally
      Doc.Free;
    end;
  finally
    Points.Free;
  end;
end;

procedure SaveAsGED(const AFigures: TFiguresArray; const AFileName: string);
var
  Data: TJSONObject;
  FiguresArr: TJSONArray;
  PointsArr: TJSONArray;
  i, j: Integer;
  F: TFigureData;
  JSONObj: TJSONObject;
  ViewState: TJSONObject;
begin
  Data := TJSONObject.Create;
  try
    FiguresArr := TJSONArray.Create;

    for i := 0 to High(AFigures) do
    begin
      F := AFigures[i];

      JSONObj := TJSONObject.Create;
      JSONObj.Add('Class', F.ClassName);

      PointsArr := TJSONArray.Create;
      for j := 0 to High(F.Points) do
        PointsArr.Add(TJSONObject.Create(['x', F.Points[j].x, 'y', F.Points[j].y]));
      JSONObj.Add('Points', PointsArr);

      JSONObj.Add('PenStyle', F.PenStyle);
      JSONObj.Add('PenColor', F.PenColor);
      JSONObj.Add('PenWidth', F.PenWidth);
      JSONObj.Add('BrushStyle', F.BrushStyle);
      JSONObj.Add('BrushColor', F.BrushColor);

      if F.ClassName = 'TRoundRectangle' then
        JSONObj.Add('Rounding', F.Rounding);

      if F.ClassName = 'TText' then
      begin
        JSONObj.Add('Text', F.Text);
        JSONObj.Add('FontName', F.FontName);
        JSONObj.Add('BaseFontSize', F.FontSize);
      end;

      FiguresArr.Add(JSONObj);
    end;

    Data.Add('GraphicEditor', FiguresArr);

    // Добавляем состояние вида
    ViewState := TJSONObject.Create;
    ViewState.Add('scale', 1.0);
    ViewState.Add('offsetX', 0.0);
    ViewState.Add('offsetY', 0.0);
    Data.Add('viewState', ViewState);

    with TStringList.Create do
    begin
      Text := Data.FormatJSON;
      SaveToFile(AFileName);
      Free;
    end;

  finally
    Data.Free;
  end;
end;

var
  InputFile, OutputFile: string;
  Figures: TFiguresArray;
begin
  if ParamCount < 1 then
  begin
    Writeln('SVG to GED Converter with PATH support');
    Writeln('Usage: svg2ged.exe input.svg [output.ged]');
    Halt(1);
  end;

  InputFile := ParamStr(1);
  if not FileExists(InputFile) then
  begin
    Writeln('Error: File not found - ', InputFile);
    Halt(1);
  end;

  if ParamCount >= 2 then
    OutputFile := ParamStr(2)
  else
    OutputFile := ChangeFileExt(InputFile, '.ged');

  try
    Writeln('Converting ', InputFile, ' -> ', OutputFile);
    Figures := SVGToGED(InputFile);
    SaveAsGED(Figures, OutputFile);
    Writeln('Done. Converted ', Length(Figures), ' figures.');
  except
    on E: Exception do
      Writeln('Error: ', E.Message);
  end;
end.

Было Svg

Код: Выделить всё

<?xml version="1.0"?>
<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN"
  "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">

<svg xmlns="http://www.w3.org/2000/svg"
     width="467" height="462">
  <rect x="80" y="60" width="250" height="250" rx="20"
     fill="#ff0000" style="stroke:#000000;stroke-width:2px;" />
  
  <rect x="141" y="121" width="251" height="251" rx="4"
      fill="#0000ff" style=" stroke:#000000; stroke-width:2px;
      fill-opacity:0.7;" />

  <rect x="140" y="120" width="250" height="250" rx="40"
     fill="#00ff00" style="stroke:#0000cc; stroke-width:5px;
      fill-opacity:1.0;" />
   <circle cx="100" cy="100" r="50" stroke="black"
    stroke-width="5" fill="red" />
  <polygon
    points=" 60,100 100,180 140,140 180,180 220,100"
    fill="green" stroke-width="2"  />
</svg>
Стало ged

Код: Выделить всё

 
 {
  "GraphicEditor" : [
    {
      "Class" : "TRoundRectangle",
      "Points" : [
        {
          "x" : 8.0000000000000000E+001,
          "y" : 6.0000000000000000E+001
        },
        {
          "x" : 3.3000000000000000E+002,
          "y" : 3.1000000000000000E+002
        }
      ],
      "PenStyle" : 0,
      "PenColor" : 0,
      "PenWidth" : 1,
      "BrushStyle" : 0,
      "BrushColor" : 255,
      "Rounding" : 20
    },
    {
      "Class" : "TRoundRectangle",
      "Points" : [
        {
          "x" : 1.4100000000000000E+002,
          "y" : 1.2100000000000000E+002
        },
        {
          "x" : 3.9200000000000000E+002,
          "y" : 3.7200000000000000E+002
        }
      ],
      "PenStyle" : 0,
      "PenColor" : 0,
      "PenWidth" : 1,
      "BrushStyle" : 0,
      "BrushColor" : 16711680,
      "Rounding" : 4
    },
    {
      "Class" : "TRoundRectangle",
      "Points" : [
        {
          "x" : 1.4000000000000000E+002,
          "y" : 1.2000000000000000E+002
        },
        {
          "x" : 3.9000000000000000E+002,
          "y" : 3.7000000000000000E+002
        }
      ],
      "PenStyle" : 0,
      "PenColor" : 0,
      "PenWidth" : 1,
      "BrushStyle" : 0,
      "BrushColor" : 65280,
      "Rounding" : 40
    },
    {
      "Class" : "TEllipse",
      "Points" : [
        {
          "x" : 5.0000000000000000E+001,
          "y" : 5.0000000000000000E+001
        },
        {
          "x" : 1.5000000000000000E+002,
          "y" : 1.5000000000000000E+002
        }
      ],
      "PenStyle" : 0,
      "PenColor" : 0,
      "PenWidth" : 5,
      "BrushStyle" : 0,
      "BrushColor" : 255
    },
    {
      "Class" : "TPolygon",
      "Points" : [
        {
          "x" : 6.0000000000000000E+001,
          "y" : 1.0000000000000000E+002
        },
        {
          "x" : 1.0000000000000000E+002,
          "y" : 1.8000000000000000E+002
        },
        {
          "x" : 1.4000000000000000E+002,
          "y" : 1.4000000000000000E+002
        },
        {
          "x" : 1.8000000000000000E+002,
          "y" : 1.8000000000000000E+002
        },
        {
          "x" : 2.2000000000000000E+002,
          "y" : 1.0000000000000000E+002
        }
      ],
      "PenStyle" : 0,
      "PenColor" : 0,
      "PenWidth" : 2,
      "BrushStyle" : 0,
      "BrushColor" : 32768
    }
  ],
  "viewState" : {
    "scale" : 1.0000000000000000E+000,
    "offsetX" : 0.0000000000000000E+000,
    "offsetY" : 0.0000000000000000E+000
  }
}

Изображение

SVG

Код: Выделить всё

<?xml version="1.0"?>
<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN"
  "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">

<svg xmlns="http://www.w3.org/2000/svg"
     width="500" height="500">

 <path d="M110 110 h 80 v 80 h -80 Z" fill="transparent" stroke="black"/>

  <circle cx="110" cy="110" r="2" fill="red"/>
  <circle cx="190" cy="190" r="2" fill="red"/>
  <circle cx="190" cy="110" r="2" fill="red"/>
  <circle cx="110" cy="190" r="2" fill="red"/>

</svg>
ged

Код: Выделить всё

{
  "GraphicEditor" : [
    {
      "Class" : "TPolygon",
      "Points" : [
        {
          "x" : 1.1000000000000000E+002,
          "y" : 1.1000000000000000E+002
        },
        {
          "x" : 1.9000000000000000E+002,
          "y" : 1.1000000000000000E+002
        },
        {
          "x" : 1.9000000000000000E+002,
          "y" : 1.9000000000000000E+002
        },
        {
          "x" : 1.1000000000000000E+002,
          "y" : 1.9000000000000000E+002
        }
      ],
      "PenStyle" : 0,
      "PenColor" : 0,
      "PenWidth" : 1,
      "BrushStyle" : 1,
      "BrushColor" : 536870911
    },
    {
      "Class" : "TEllipse",
      "Points" : [
        {
          "x" : 1.0800000000000000E+002,
          "y" : 1.0800000000000000E+002
        },
        {
          "x" : 1.1200000000000000E+002,
          "y" : 1.1200000000000000E+002
        }
      ],
      "PenStyle" : 0,
      "PenColor" : 0,
      "PenWidth" : 1,
      "BrushStyle" : 0,
      "BrushColor" : 255
    },
    {
      "Class" : "TEllipse",
      "Points" : [
        {
          "x" : 1.8800000000000000E+002,
          "y" : 1.8800000000000000E+002
        },
        {
          "x" : 1.9200000000000000E+002,
          "y" : 1.9200000000000000E+002
        }
      ],
      "PenStyle" : 0,
      "PenColor" : 0,
      "PenWidth" : 1,
      "BrushStyle" : 0,
      "BrushColor" : 255
    },
    {
      "Class" : "TEllipse",
      "Points" : [
        {
          "x" : 1.8800000000000000E+002,
          "y" : 1.0800000000000000E+002
        },
        {
          "x" : 1.9200000000000000E+002,
          "y" : 1.1200000000000000E+002
        }
      ],
      "PenStyle" : 0,
      "PenColor" : 0,
      "PenWidth" : 1,
      "BrushStyle" : 0,
      "BrushColor" : 255
    },
    {
      "Class" : "TEllipse",
      "Points" : [
        {
          "x" : 1.0800000000000000E+002,
          "y" : 1.8800000000000000E+002
        },
        {
          "x" : 1.1200000000000000E+002,
          "y" : 1.9200000000000000E+002
        }
      ],
      "PenStyle" : 0,
      "PenColor" : 0,
      "PenWidth" : 1,
      "BrushStyle" : 0,
      "BrushColor" : 255
    }
  ],
  "viewState" : {
    "scale" : 1.0000000000000000E+000,
    "offsetX" : 0.0000000000000000E+000,
    "offsetY" : 0.0000000000000000E+000
  }
}

Изображение
Последний раз редактировалось Alex2013 26.02.2026 11:17:23, всего редактировалось 3 раза.
Alex2013
долгожитель
Сообщения: 3248
Зарегистрирован: 03.04.2013 11:59:44

Сообщение Alex2013 »

Для комплекта "обратный" конвертер ged2svg

Код: Выделить всё

program ged2svg;

{$mode objfpc}{$H+}

uses
  Classes, SysUtils, fpjson, jsonparser, Math, Graphics;

type
  TDPoint = record
    x, y: double;
  end;
  TDPointArray = array of TDPoint;

  TFigureData = record
    ClassName: string;
    Points: TDPointArray;
    PenColor: Integer;
    PenWidth: Integer;
    PenStyle: Integer;  // 0..5
    BrushColor: Integer;
    BrushStyle: Integer; // 0..7
    Rounding: Integer;
    Text: string;
    FontName: string;
    FontSize: Integer;
  end;

  TFiguresArray = array of TFigureData;

// Преобразование TColor в SVG цвет
function ColorToSVG(AColor: Integer): string;
var
  R, G, B: Byte;
begin
  if AColor = clNone then
    Result := 'none'
  else
  begin
    RedGreenBlue(AColor, R, G, B);
    Result := Format('rgb(%d,%d,%d)', [R, G, B]);
  end;
end;

// Преобразование стиля пера в SVG stroke-dasharray
function PenStyleToSVG(AStyle: Integer): string;
begin
  case AStyle of
    0: Result := 'none';      // psSolid в SVG это none
    1: Result := 'none';      // psClear
    2: Result := '2,2';       // psDot
    3: Result := '5,3';       // psDash
    4: Result := '5,3,2,3';   // psDashDot
    5: Result := '5,3,2,3,2,3'; // psDashDotDot
    else Result := 'none';
  end;
end;

// Преобразование стиля заливки
function BrushStyleToSVG(AStyle: Integer; AColor: Integer): string;
begin
  if (AStyle = 1) or (AColor = clNone) then // bsClear или прозрачный цвет
    Result := 'none'
  else
    Result := ColorToSVG(AColor);
end;

// Очистка строки JSON от возможных внешних кавычек
function CleanJSONString(const S: string): string;
begin
  Result := Trim(S);
  // Удаляем внешние кавычки, если они есть
  if (Length(Result) >= 2) and (Result[1] = '"') and (Result[Length(Result)] = '"') then
    Result := Copy(Result, 2, Length(Result) - 2);
  // Удаляем лишние пробелы
  Result := Trim(Result);
end;

// Загрузка GED файла
function LoadGED(const AFileName: string): TFiguresArray;
var
  JSONData: TJSONData;
  JSONObj: TJSONObject;
  FiguresArr: TJSONArray;
  FigureObj: TJSONObject;
  PointsArr: TJSONArray;
  PointObj: TJSONObject;
  i, j: Integer;
  F: TFigureData;
  FileContent: TStringList;
  CleanContent: string;
  Parser: TJSONParser;
begin
  Result := nil;

  try
    // Читаем файл как текст
    FileContent := TStringList.Create;
    try
      FileContent.LoadFromFile(AFileName);
      CleanContent := CleanJSONString(FileContent.Text);

      // Создаем парсер с очищенной строкой
      Parser := TJSONParser.Create(CleanContent, False);
      try
        JSONData := Parser.Parse;
      finally
        Parser.Free;
      end;

      if JSONData = nil then
      begin
        Writeln('Error: Invalid JSON format');
        Exit;
      end;

      try
        if not (JSONData is TJSONObject) then
        begin
          Writeln('Error: Root is not a JSON object');
          Exit;
        end;

        JSONObj := TJSONObject(JSONData);
        FiguresArr := JSONObj.Get('GraphicEditor', TJSONArray(nil));

        if FiguresArr = nil then
        begin
          Writeln('Error: GraphicEditor array not found');
          Exit;
        end;

        SetLength(Result, FiguresArr.Count);

        for i := 0 to FiguresArr.Count - 1 do
        begin
          FigureObj := FiguresArr[i] as TJSONObject;
          F.ClassName := FigureObj.Get('Class', '');

          // Читаем точки
          PointsArr := FigureObj.Get('Points', TJSONArray(nil));
          if PointsArr <> nil then
          begin
            SetLength(F.Points, PointsArr.Count);
            for j := 0 to PointsArr.Count - 1 do
            begin
              PointObj := PointsArr[j] as TJSONObject;
              F.Points[j].x := PointObj.Get('x', 0.0);
              F.Points[j].y := PointObj.Get('y', 0.0);
            end;
          end;

          // Читаем стили
          F.PenStyle := FigureObj.Get('PenStyle', 0);
          F.PenColor := FigureObj.Get('PenColor', clBlack);
          F.PenWidth := FigureObj.Get('PenWidth', 1);
          F.BrushStyle := FigureObj.Get('BrushStyle', 1);
          F.BrushColor := FigureObj.Get('BrushColor', clWhite);

          // Специфичные поля
          if F.ClassName = 'TRoundRectangle' then
            F.Rounding := FigureObj.Get('Rounding', 10);

          if F.ClassName = 'TText' then
          begin
            F.Text := FigureObj.Get('Text', '');
            F.FontName := FigureObj.Get('FontName', 'Arial');
            F.FontSize := FigureObj.Get('BaseFontSize', 12);
          end;

          Result[i] := F;
        end;

        Writeln('Successfully loaded ', Length(Result), ' figures');

      finally
        JSONData.Free;
      end;

    finally
      FileContent.Free;
    end;

  except
    on E: Exception do
      Writeln('Error loading GED: ', E.Message);
  end;
end;

// Сохранение в SVG
procedure SaveSVG(const AFileName: string; const AFigures: TFiguresArray);
var
  SL: TStringList;
  i, j: Integer;
  F: TFigureData;
  PointsStr: string;
  X, Y: Double;
  ViewBoxWidth, ViewBoxHeight: Double;
  MinX, MinY, MaxX, MaxY: Double;
  HasFigure: Boolean;
begin
  if Length(AFigures) = 0 then
  begin
    Writeln('No figures to save');
    Exit;
  end;

  SL := TStringList.Create;
  try
    // Вычисляем границы для viewBox
    MinX := 0; MinY := 0; MaxX := 800; MaxY := 600;
    HasFigure := False;

    for i := 0 to High(AFigures) do
    begin
      F := AFigures[i];
      for j := 0 to High(F.Points) do
      begin
        if not HasFigure then
        begin
          MinX := F.Points[j].x;
          MinY := F.Points[j].y;
          MaxX := F.Points[j].x;
          MaxY := F.Points[j].y;
          HasFigure := True;
        end
        else
        begin
          if F.Points[j].x < MinX then MinX := F.Points[j].x;
          if F.Points[j].x > MaxX then MaxX := F.Points[j].x;
          if F.Points[j].y < MinY then MinY := F.Points[j].y;
          if F.Points[j].y > MaxY then MaxY := F.Points[j].y;
        end;
      end;
    end;

    // Добавляем отступы
    MinX := MinX - 20;
    MinY := MinY - 20;
    MaxX := MaxX + 20;
    MaxY := MaxY + 20;
    ViewBoxWidth := MaxX - MinX;
    ViewBoxHeight := MaxY - MinY;

    // Начало SVG
    SL.Add('<?xml version="1.0" encoding="UTF-8"?>');
    SL.Add('<svg xmlns="http://www.w3.org/2000/svg"');
    SL.Add(Format('     viewBox="%d %d %d %d">',
          [Round(MinX), Round(MinY), Round(ViewBoxWidth), Round(ViewBoxHeight)]));

    // Добавляем определения для штриховок (опционально)
    SL.Add('  <defs>');
    SL.Add('    <pattern id="hatchHorizontal" patternUnits="userSpaceOnUse" width="4" height="4">');
    SL.Add('      <path d="M0 2 L4 2" stroke="black" stroke-width="0.5"/>');
    SL.Add('    </pattern>');
    SL.Add('    <pattern id="hatchVertical" patternUnits="userSpaceOnUse" width="4" height="4">');
    SL.Add('      <path d="M2 0 L2 4" stroke="black" stroke-width="0.5"/>');
    SL.Add('    </pattern>');
    SL.Add('    <pattern id="hatchDiagonal" patternUnits="userSpaceOnUse" width="4" height="4">');
    SL.Add('      <path d="M0 4 L4 0" stroke="black" stroke-width="0.5"/>');
    SL.Add('    </pattern>');
    SL.Add('  </defs>');

    // Фигуры
    for i := 0 to High(AFigures) do
    begin
      F := AFigures[i];

      if F.ClassName = 'TRectangle' then
      begin
        if Length(F.Points) >= 2 then
        begin
          SL.Add(Format('  <rect x="%g" y="%g" width="%g" height="%g"',
                [F.Points[0].x, F.Points[0].y,
                 F.Points[1].x - F.Points[0].x,
                 F.Points[1].y - F.Points[0].y]));
          SL.Add(Format('        stroke="%s" stroke-width="%d" fill="%s" />',
                [ColorToSVG(F.PenColor), F.PenWidth,
                 BrushStyleToSVG(F.BrushStyle, F.BrushColor)]));
        end;
      end

      else if F.ClassName = 'TRoundRectangle' then
      begin
        if Length(F.Points) >= 2 then
        begin
          SL.Add(Format('  <rect x="%g" y="%g" width="%g" height="%g" rx="%d" ry="%d"',
                [F.Points[0].x, F.Points[0].y,
                 F.Points[1].x - F.Points[0].x,
                 F.Points[1].y - F.Points[0].y,
                 F.Rounding, F.Rounding]));
          SL.Add(Format('        stroke="%s" stroke-width="%d" fill="%s" />',
                [ColorToSVG(F.PenColor), F.PenWidth,
                 BrushStyleToSVG(F.BrushStyle, F.BrushColor)]));
        end;
      end

      else if F.ClassName = 'TEllipse' then
      begin
        if Length(F.Points) >= 2 then
        begin
          X := (F.Points[0].x + F.Points[1].x) / 2;
          Y := (F.Points[0].y + F.Points[1].y) / 2;
          SL.Add(Format('  <ellipse cx="%g" cy="%g" rx="%g" ry="%g"',
                [X, Y,
                 (F.Points[1].x - F.Points[0].x) / 2,
                 (F.Points[1].y - F.Points[0].y) / 2]));
          SL.Add(Format('        stroke="%s" stroke-width="%d" fill="%s" />',
                [ColorToSVG(F.PenColor), F.PenWidth,
                 BrushStyleToSVG(F.BrushStyle, F.BrushColor)]));
        end;
      end

      else if F.ClassName = 'TLine' then
      begin
        if Length(F.Points) >= 2 then
        begin
          SL.Add(Format('  <line x1="%g" y1="%g" x2="%g" y2="%g"',
                [F.Points[0].x, F.Points[0].y,
                 F.Points[1].x, F.Points[1].y]));
          SL.Add(Format('        stroke="%s" stroke-width="%d" stroke-dasharray="%s" />',
                [ColorToSVG(F.PenColor), F.PenWidth,
                 PenStyleToSVG(F.PenStyle)]));
        end;
      end

      else if (F.ClassName = 'TPolyLine') or (F.ClassName = 'TPolygon') then
      begin
        if Length(F.Points) >= 2 then
        begin
          PointsStr := '';
          for j := 0 to High(F.Points) do
          begin
            if j > 0 then PointsStr := PointsStr + ' ';
            PointsStr := PointsStr + Format('%g,%g', [F.Points[j].x, F.Points[j].y]);
          end;

          if F.ClassName = 'TPolyLine' then
            SL.Add('  <polyline points="' + PointsStr + '"')
          else
            SL.Add('  <polygon points="' + PointsStr + '"');

          SL.Add(Format('        stroke="%s" stroke-width="%d" stroke-dasharray="%s" fill="%s" />',
                [ColorToSVG(F.PenColor), F.PenWidth,
                 PenStyleToSVG(F.PenStyle),
                 BrushStyleToSVG(F.BrushStyle, F.BrushColor)]));
        end;
      end

      else if F.ClassName = 'TText' then
      begin
        if Length(F.Points) >= 1 then
        begin
          SL.Add(Format('  <text x="%g" y="%g"', [F.Points[0].x, F.Points[0].y]));
          SL.Add(Format('        font-family="%s" font-size="%d"',
                [F.FontName, F.FontSize]));
          SL.Add(Format('        fill="%s">', [ColorToSVG(F.PenColor)]));
          SL.Add('    ' + F.Text);
          SL.Add('  </text>');
        end;
      end

      else if F.ClassName = 'TImageFigure' then
      begin
        // В SVG изображения не поддерживаются напрямую,
        // можно добавить как <image> если есть данные
        if Length(F.Points) >= 2 then
        begin
          SL.Add(Format('  <rect x="%g" y="%g" width="%g" height="%g"',
                [F.Points[0].x, F.Points[0].y,
                 F.Points[1].x - F.Points[0].x,
                 F.Points[1].y - F.Points[0].y]));
          SL.Add('        stroke="black" stroke-width="1" fill="none" stroke-dasharray="5,5" />');
          SL.Add(Format('  <text x="%g" y="%g" font-size="12" fill="gray">[Image]</text>',
                [F.Points[0].x + 5, F.Points[0].y + 20]));
        end;
      end;
    end;

    SL.Add('</svg>');
    SL.SaveToFile(AFileName);
    Writeln('SVG saved to ', AFileName);

  finally
    SL.Free;
  end;
end;

var
  InputFile, OutputFile: string;
  Figures: TFiguresArray;
begin
  if ParamCount < 1 then
  begin
    Writeln('GED to SVG Converter');
    Writeln('Usage: ged2svg.exe input.ged [output.svg]');
    Halt(1);
  end;

  InputFile := ParamStr(1);
  if not FileExists(InputFile) then
  begin
    Writeln('Error: File not found - ', InputFile);
    Halt(1);
  end;

  if ParamCount >= 2 then
    OutputFile := ParamStr(2)
  else
    OutputFile := ChangeFileExt(InputFile, '.svg');

  try
    Writeln('Converting ', InputFile, ' -> ', OutputFile);
    Figures := LoadGED(InputFile);

    if Length(Figures) > 0 then
    begin
      SaveSVG(OutputFile, Figures);
      Writeln('Done. Converted ', Length(Figures), ' figures.');
    end
    else
      Writeln('No figures found in file.');

  except
    on E: Exception do
      Writeln('Error: ', E.Message);
  end;
end.

GED
{ "GraphicEditor" : [{ "Class" : "TRectangle", "Points" : [{ "x" : 7.1000000000000000E+001, "y" : 7.1000000000000000E+001 }, { "x" : 3.7200000000000000E+002, "y" : 2.9100000000000000E+002 }], "PenStyle" : 0, "PenColor" : 0, "PenWidth" : 1, "BrushStyle" : 1, "BrushColor" : 16777215 }, { "Class" : "TPolygon", "Points" : [{ "x" : 1.0100000000000000E+002, "y" : 1.3700000000000000E+002 }, { "x" : 2.4100000000000000E+002, "y" : 8.5000000000000000E+001 }, { "x" : 3.4000000000000000E+002, "y" : 2.4800000000000000E+002 }, { "x" : 1.3500000000000000E+002, "y" : 2.5000000000000000E+002 }], "PenStyle" : 0, "PenColor" : 0, "PenWidth" : 1, "BrushStyle" : 1, "BrushColor" : 16777215 }, { "Class" : "TRoundRectangle", "Points" : [{ "x" : 1.3900000000000000E+002, "y" : 1.5200000000000000E+002 }, { "x" : 2.6800000000000000E+002, "y" : 2.1100000000000000E+002 }], "PenStyle" : 0, "PenColor" : 0, "PenWidth" : 1, "BrushStyle" : 1, "BrushColor" : 16777215, "Rouding" : 100 }, { "Class" : "TEllipse", "Points" : [{ "x" : 1.9500000000000000E+002, "y" : 1.5500000000000000E+002 }, { "x" : 3.5500000000000000E+002, "y" : 3.0000000000000000E+002 }], "PenStyle" : 0, "PenColor" : 0, "PenWidth" : 1, "BrushStyle" : 1, "BrushColor" : 16777215 }, { "Class" : "TEllipse", "Points" : [{ "x" : 3.6000000000000000E+002, "y" : 2.9800000000000000E+002 }], "PenStyle" : 0, "PenColor" : 0, "PenWidth" : 1, "BrushStyle" : 1, "BrushColor" : 16777215 }, { "Class" : "TText", "Points" : [{ "x" : 7.5000000000000000E+001, "y" : 2.9500000000000000E+002 }], "PenStyle" : 0, "PenColor" : 0, "PenWidth" : 0, "BrushStyle" : 1, "BrushColor" : 16777215, "Text" : "Text", "FontName" : "Arial", "BaseFontSize" : 12 }], "viewState" : { "scale" : 1.0000000000000000E+000, "offsetX" : 0.0000000000000000E+000, "offsetY" : 0.0000000000000000E+000 } }
SVG

Код: Выделить всё

<?xml version="1.0" encoding="UTF-8"?>
<svg xmlns="http://www.w3.org/2000/svg"
     viewBox="51 51 341 269">
  <defs>
    <pattern id="hatchHorizontal" patternUnits="userSpaceOnUse" width="4" height="4">
      <path d="M0 2 L4 2" stroke="black" stroke-width="0.5"/>
    </pattern>
    <pattern id="hatchVertical" patternUnits="userSpaceOnUse" width="4" height="4">
      <path d="M2 0 L2 4" stroke="black" stroke-width="0.5"/>
    </pattern>
    <pattern id="hatchDiagonal" patternUnits="userSpaceOnUse" width="4" height="4">
      <path d="M0 4 L4 0" stroke="black" stroke-width="0.5"/>
    </pattern>
  </defs>
  <rect x="71" y="71" width="301" height="220"
        stroke="rgb(0,0,0)" stroke-width="1" fill="none" />
  <polygon points="101,137 241,85 340,248 135,250"
        stroke="rgb(0,0,0)" stroke-width="1" stroke-dasharray="none" fill="none" />
  <rect x="139" y="152" width="129" height="59" rx="10" ry="10"
        stroke="rgb(0,0,0)" stroke-width="1" fill="none" />
  <ellipse cx="275" cy="227,5" rx="80" ry="72,5"
        stroke="rgb(0,0,0)" stroke-width="1" fill="none" />
  <text x="75" y="295"
        font-family="Arial" font-size="12"
        fill="rgb(0,0,0)">
    Text
  </text>
</svg>
Ответить