February 2012
    Get Version

January 2007
» Bezier Text

December 2005
    Rotated Ellipses

December 2004
    PDF Page Count

January 2003
    Boolean Blues

March 2002
    Networked Drives

January 2002
    Treeview Troubles
    Appending to Exe's

Freeware Components
Drawing Text along a Path January 2007

Firstly, this can be implemented in one of two ways:
  • spreading characters evenly along the path, or
  • keeping the font's character spacing and centering the text on the path.

However, before we start, there are a couple of tips to note:

When drawing characters along a path, although the algorithm is a little more complicated, it looks best when the characters are drawn using the angle of the curve at each character's midpoint (though the differences are only subtle in the following example):
Using angle at left edge of characters     Using angle at middle of characters

Also, to avoid excessive character bunching inside curves and excessive character spreading outside curves it's best to have the text positioned directly on top of the path (not above or below it).

Anyhow, while there's nothing complicated about this process, there are a number of steps so it requires a little patience.

Steps to spread characters evenly spaced along a path:

  1. Define the path (eg a bezier curve)
  2. 'Flatten' the path to create an array of points pathPts[] which represent the path
  3. Calculate the length of each path segment (distance between points) and save the cumulative totals of these lengths in another array - distances[] (ie an array of distances from the start of the path to each point in path).
  4. Calculate the width of each character in the Text for the given font and canvas (device context).
  5. Calculate the necessary space (width) between each character
    interChrSpc = (lengthOfPath-totalAllCharWidths)/NumberOfSpaces
  6. Now, for each character:
    1. Calculate distance d from the start of the text to it's midpoint (based on charWidths and interCharSpace)
    2. Using distances[] - find the corresponding point in pathPts[] - pathPts[i] - that's just greater than distance d.
    3. Calculate the angle a of the segment pathPts[i-1] & pathPts[i].
    4. Again using distances[], find exact point p between pathPts[i-1] & pathPts[i] that corresponds with distance d in step 6i.
    5. Using angle a, find the point at which character drawing starts (ie top left corner of char) from point p.
    6. Finally draw the character at angle a.

Code snippet ...
unit beziertext;


  Windows, Graphics, Math;

procedure TextAlongBezier(canvas: TCanvas;
  bezierPts: array of TPoint; const s: string);


//Helper functions

function DistanceBetween2Pts(pt1,pt2: TPoint): single;
  result := sqrt((pt1.X - pt2.X)*(pt1.X - pt2.X) +
    (pt1.Y - pt2.Y)*(pt1.Y - pt2.Y));

function GetPtAtDistAndAngleFromPt(pt: TPoint;
  dist: integer; angle: single): TPoint;
  result.X := round(dist * cos(angle));
  result.Y := -round(dist * sin(angle)); //nb: Y axis is +ve down
  inc(result.X , pt.X);
  inc(result.Y , pt.Y);

function PtBetween2Pts(pt1, pt2: TPoint;
  relativeDistFromPt1: single): TPoint;
  //nb: 0 <= relativeDistFromPt1 <= 1
  if pt2.X = pt1.X then
    result.X := pt2.X else
    result.X := pt1.X + round((pt2.X - pt1.X)*relativeDistFromPt1);
  if pt2.Y = pt1.Y then
    result.Y := pt2.Y else
    result.Y := pt1.Y + round((pt2.Y - pt1.Y)*relativeDistFromPt1);

function GetAnglePt2FromPt1(pt1, pt2: TPoint): single;
  //nb: result is in radians
  with pt2 do
    if X = 0 then
      result := pi/2;
      if Y > 0 then result := 3*result; //nb: Y axis is +ve down
    end else
      result := arctan2(-Y,X);
      if result < 0 then result := result + pi * 2;

procedure AngledCharOut(Canvas: TCanvas; pt: TPoint;
  c: char; radians: single; offsetX, offsetY: integer);
  lf: TLogFont;
  OldFontHdl,NewFontHdl: HFont;
  angle: integer;
  angle := round(radians * 180/pi);
  if angle > 180 then angle := angle - 360;

  //workaround because textout() without any rotation is malaligned
  //relative to other rotated text ...
  if angle = 0 then angle := 1;

  with Canvas do
    //create an angled font based on the current canvas's font ...
    if GetObject(Font.Handle, SizeOf(lf), @lf) = 0 then exit;
    lf.lfEscapement := Angle * 10;
    lf.lfOrientation := Angle * 10;
    lf.lfOutPrecision := OUT_TT_ONLY_PRECIS;
    NewFontHdl := CreateFontIndirect(lf);
    OldFontHdl := selectObject(handle,NewFontHdl);
    //offset the character by the (rotated) X & Y amounts ...
    if offsetX < 0 then
      pt := GetPtAtDistAndAngleFromPt(pt, -offsetX, radians + Pi)
    else if offsetX > 0 then
      pt := GetPtAtDistAndAngleFromPt(pt, offsetX, radians);
    if offsetY < 0 then
      pt := GetPtAtDistAndAngleFromPt(pt, -offsetY, radians + pi/2)
    else if offsetY > 0 then
      pt := GetPtAtDistAndAngleFromPt(pt, offsetY, radians - pi/2);
    //draw the rotated character ...
    TextOut(pt.x, pt.y, c);
    //finally restore the unrotated canvas font ...

// TextAlongBezier()

procedure TextAlongBezier(canvas: TCanvas;
  bezierPts: array of TPoint; const s: string);
  i, j, ptCnt, textLenPxls, textLenChars, vertOffset: integer;
  currentInsertionDist, charWidthDiv2: integer;
  pt: TPoint;
  flatPts: array of TPoint;
  types: array of byte;
  distances: array of single;
  dummyPtr: pointer;
  angle, spcPxls, bezierLen, relativeDistFRomPt1: single;
  charWidths: array[#32..#255] of integer;
  textLenChars := length(s);
  //make sure there's text and a valid number of bezier points ...
  if (textLenChars = 0) or (high(bezierPts) mod 3 <> 0) then exit;

  with canvas do
    //Create the path ...
    //'Flatten' the path ...

    //Get Character widths for every printable character of the given font
    if not GetCharWidth32(handle,32,255, charWidths[#32]) then exit;

    //First get the number of points needed to define the 'flattened' path
    dummyPtr := nil; //nb: dummyPtr will be ignored in the GetPath() call
    ptCnt := GetPath(handle, dummyPtr, dummyPtr, 0);
    if ptCnt < 1 then exit;

    setLength(flatPts, ptCnt);
    setLength(types, ptCnt);
    setLength(distances, ptCnt);

    //Now we know the number of points needed, call GetPath() again
    //this time assigning the array of points (flatPts) ...
    GetPath(handle, flatPts[0], types[0], ptCnt);

    //calculate and fill the distances array ...
    distances[0] := 0;
    bezierLen := 0;
    for i := 1 to ptCnt -1 do
      bezierLen := bezierLen +
        DistanceBetween2Pts(flatPts[i], flatPts[i-1]);
      distances[i] := bezierLen;

    //calc length of text in pixels ...
    textLenPxls := 0;
    for i := 1 to textLenChars do inc(textLenPxls, charWidths[s[i]]);

    //calc space between chars to spread string along entire curve ...
    if textLenChars = 1 then
      spcPxls := 0 else
      spcPxls := (bezierLen - textLenPxls)/(textLenChars -1);

    SetBkMode (handle, TRANSPARENT);

    //Position the text over the top of the curve.
    //Empirically, moving characters up 2/3 of TextHeight seems OK ...
    vertOffset := -trunc(2/3* TextHeight('Yy'));

    j := 1;
    currentInsertionDist := 0;
    for i := 1 to textLenChars do
      charWidthDiv2 := charWidths[s[i]] div 2;
      //increment currentInsertionDist half the width of char to get
      //the slope of the curve at the midpoint of that character ...
      inc(currentInsertionDist, charWidthDiv2);

      //find the point on the flattened path corresponding to the
      //midpoint of the current character ...
      while (j < ptCnt -1) and (distances[j] < currentInsertionDist) do
      if distances[j] = currentInsertionDist then
        pt := flatPts[j]
        relativeDistFRomPt1 := (currentInsertionDist - distances[j-1]) /
          (distances[j] - distances[j-1]);
        pt := PtBetween2Pts(flatPts[j-1],flatPts[j],relativeDistFRomPt1);
      //get the angle of the path at this point ...
      angle := GetAnglePt2FromPt1(flatPts[j-1], flatPts[j]);

      //finally, draw the character at the given angle  ...
      AngledCharOut(canvas,pt,s[i], angle, -charWidthDiv2, vertOffset);

      //increment currentInsertionDist to the start of next character ...
        charWidthDiv2 + trunc(spcPxls) + round(frac(spcPxls*i)));

    //debug only - draw the path from the points ...
    //with flatPts[0] do canvas.moveto(X,Y);
    //for i := 1 to ptCnt -1 do with flatPts[i] do canvas.lineto(X,Y);


And an example of calling TextAlongBezier() ...
procedure TForm1.FormPaint(Sender: TObject);
  //Font.Name := "Tahoma"; Font.Size := 48; Font.Style := [fsBold];
      [Point(300,100), Point(500,100), Point(500,400),
      Point(300,400), Point(100,400), Point(100,100), Point(300,100)],
      ' Try this quick quiz ');

Copyright © 2002-2007 Angus Johnson