Draw text alongside a curve

Problem/Question/Abstract:

How to draw text alongside a curve

Answer:

You need a free rotatable text and the exact measurement of fonts. I use the ATM metrix, but you can also try textwidth or textheight. I use this code under Windows NT to draw symbols along a polygon line.

procedure TDrawer.fOutSymbolXYW(w: Double; x, y: Integer; S: string);
var
  nx, ny, xw, xh: Integer;
  O, T: TXForm;
  sc, cHg, fHg: Double;
begin
  nx := 0;
  ny := 0;
  cHg := fFontMetrix.fY2 - fFontMetrix.fY1; {I use Adobe one}
  fHg := TextHeight(S);
  if fHG = 0 then
    Exit;
  Sc := cHg / fHg;
  xw := OperateFont(Textwidth(S));
  xh := OperateFont(SymbolHeight(S));
  case TextJust of
    tjCenterTop:
      begin
        nx := -xw div 2;
        ny := 0;
      end;
    tjCenterBottom:
      begin
        nx := -xw div 2;
        ny := -xh;
      end;
    tjCenterCenter:
      begin
        nx := -xw div 2;
        ny := -xh div 2;
      end;
    tjLeftTop:
      begin
        nx := 0;
        ny := 0;
      end;
    tjLeftCenter:
      begin
        nx := 0;
        ny := -xh div 2;
      end;
    tjLeftBottom:
      begin
        nx := 0;
        ny := -xh;
      end;
    tjRightCenter:
      begin
        nx := -xw;
        ny := -xh div 2;
      end;
    tjRightTop:
      begin
        nx := -xw;
        ny := 0;
      end;
    tjRightBottom:
      begin
        nx := -xw;
        ny := -xh;
      end;
  end;
  SetGraphicsMode(TheDraw.Handle, GM_Advanced);
  T.eM11 := 1 * Cos(w / 360 * Pi * 2);
  T.eM22 := 1 * Cos(w / 360 * Pi * 2);
  T.eM12 := 1 * Sin(w / 360 * Pi * 2);
  T.eM21 := 1 * -Sin(w / 360 * Pi * 2);
  T.eDX := X;
  T.eDY := Y;
  GetWorldTransform(TheDraw.Handle, O);
  ModifyWorldTransform(TheDraw.Handle, T, MWT_LEFTMULTIPLY);
  { TheDraw.Pen.Style := psClear;
  TheDraw.Rectangle(nx - 1, ny - 1, nx + xw + 3, ny + xh + 2); }
  TheDraw.TextOut(nx + OperateFont(FFontMetrix.fX1 / SC), ny -
    OperateFont(TextHeight(S)
    - SymbolHeight(S) + FFontMetrix.fY1 / sc), S);
  { SetPen(0, 200, 0, 0. 25, psSolid);
  TheDraw.Ellipse(nx - 1, ny - 1, nx + 1, ny + 1); }
  T.eM11 := 1;
  T.eM22 := 1;
  T.eM12 := 0;
  T.eM21 := 0;
  T.eDX := 0;
  T.eDY := 0;
  SetWorldTransform(TheDraw.Handle, O);
end;

procedure TDrawer.SymbolLine(Poly: TXYPointList; Distance: Double; Offset: Double;
  StartAngle: Double; R, G, B: Byte; Lib: string; CharSet: Byte; Size: Double; Style:
    TFontStyles;
  Sign: Char);
var
  i, Segment: Integer;
  PosX, PosY, TargetLength, CurrentLength: Double;
  {P, pxy: TXYpoint;}
  s, c: Double;
  Angle: Double;

  {Locates the angle of symbol at one linepoint}
  procedure LANGLE(j: Integer; var s, c: Double);
  var
    x1, x2, y1, y2, l: Double;
  begin
    x1 := Poly.Points[j].x;
    x2 := Poly.Points[j - 1].x;
    y1 := Poly.Points[j].y;
    y2 := Poly.Points[j - 1].y;
    l := sqrt(sqr(x2 - x1) + sqr(y2 - y1));
    s := (x1 - x2) / l;
    c := (y2 - y1) / l;
  end;

  {Llocates the angle of symbol between to lines linepoints}
  procedure SLANGLE(j: Integer; var s, c: Double);
  var
    x1, x2, y1, y2, l: Double;
  begin
    x1 := Poly.Points[j - 1].x;
    x2 := Poly.Points[j + 1].x;
    y1 := Poly.Points[j - 1].y;
    y2 := Poly.Points[j + 1].y;
    l := sqrt(sqr(x2 - x1) + sqr(y2 - y1));
    s := (x1 - x2) / l;
    c := (y2 - y1) / l;
  end;

  function Place(L: Double; var x, y: Double; var Pl: Double; var Index: integer;
    var s, c: Double): Boolean;
  var
    x1, x2, y1, y2: Real;
    l1, l2: Real;
    j: Integer;
  begin
    Place := False;
    if L < 0 then
      Exit;
    j := index;
    while (l >= Pl) and (j < Poly.MaxPoint) do
    begin
      inc(j);
      x1 := Poly.Points[j - 1].x;
      x2 := Poly.Points[j].x;
      y1 := Poly.Points[j - 1].y;
      y2 := Poly.Points[j].y;
      pl := pl + sqrt(sqr(x2 - x1) + sqr(y2 - y1));
    end;
    if not (l < Pl) and (j >= Poly.MaxPoint) then
      Exit;
    if (l = pl) then
    begin
      X := Poly.Points[j].X;
      Y := Poly.Points[j].Y;
      if j = Poly.MaxPoint then
        LAngle(j, s, c)
      else if j = 1 then
        LAngle(2, s, c)
      else
        SLAngle(j, s, c);
      Exit;
    end;
    x1 := Poly.Points[j - 1].x;
    x2 := Poly.Points[j].x;
    y1 := Poly.Points[j - 1].y;
    y2 := Poly.Points[j].y;
    l1 := sqrt(sqr(x2 - x1) + sqr(y2 - y1));
    if j < 3 then
      l2 := l
    else
      l2 := l - (Pl - l1);
    x := l2 / l1 * (x2 - x1) + Poly.Points[j - 1].x;
    y := l2 / l1 * (y2 - y1) + Poly.Points[j - 1].y;
    if j <> index then
      LANGLE(j, s, c);
    index := j;
    Place := True;
  end;

begin
  SetSymbols(R, G, B, LIB, Charset, Size, Style);
  if Distance = 0 then
    Distance := 1;
  CurrentLength := 0;
  TargetLength := Poly.PolyLength;
  Segment := 1;
  i := -1;
  if (Poly.MaxPoint < 2) or (Poly.PolyLength < Distance + Offset) then
    Exit;
  repeat
    Inc(i);
    if Place(Offset + Distance * i, PosX, PosY, CurrentLength, Segment, S, C) then
    begin
      Angle := ArcTan2(S, C) / 2 / Pi * 360;
      OutSymbolXYW(Angle + StartAngle, PosX, PosY, Sign);
    end;
  until
    Offset + Distance * i >= TargetLength;
end;