For the examples that I posted previously, I was using a fairly bulky subroutine to rotate and position the text. It has far more bells and whistles than is needed here. I’ve now had a bit of time to pare things down to a more reasonable size and have created a subroutine for drawing the fan chart text. The main fan chart subroutine has also been slightly revised so that it takes the root person node (the person at the centre of the chart) as a parameter, and then traverses the family tree to get all of the text information to be displayed. For this I’m assuming that all of the family tree data already exists and the ‘person’ class contains the following properties:
class person
Public Property Name as string
Public Property Birth as date
Public Property Marriage as date
Public Property Death as date
Public Property father as Person
Public Property mother as Person
Public Property Children() as Person
end class
The children() property is not necessary for this example, but would likely be required for a general family tree application to allow traversing the tree in both directions
This is the subroutine that draws the rotated text:
Public Sub DrawNodeText(g As Graphics,xOrigin as integer,yOrigin as integer, node As Integer, p As Person,radius As Double,radIncr As Double,angle As Double,fsize As Double)
'Draws person's name and vital dates on fan chart
' as rotated text, at the given the origin, angle,
' radius, and incremental radial distance between items.
Const pi = 3.14159265358979
dim x,y,i,w,h As Integer
dim rad,txtRot As Double
dim output() As string
dim s As new StringShape
Dim pTest as new Picture(1,1)
'Allow different text styles for each text item
static txtClr() As Color = Array(&c000000,&c050580,&c000000,&c000000,&c000000)
static textBold() As Boolean = Array(false,true,false,false,false)
'Text is perpendicular to the radial angle
txtRot=pi*0.5-angle
'Text parameters
s.TextFont = "Times"
s.TextSize = fsize
s.HorizontalAlignment = StringShape.Alignment.Left
s.VerticalAlignment = StringShape.Alignment.Bottom
s.Rotation = txtRot
'Test picture pTest is used for measuring stringshape width and height
' using a method suggested by Alwyn Bester
pTest.Graphics.TextFont = s.TextFont
pTest.Graphics.TextSize = s.TextSize
pTest.Graphics.TextUnit = s.TextUnit
'Load text items into array
output=array(str(node),p.Name,"b. "+p.Birth.ShortDate,"","")
'Person may be alive and/or unmarried so check for nil dates
if p.Marriage <> nil then output(3) = "m. "+p.Marriage.ShortDate
if p.Death <> nil then output(4) = "d. "+p.Death.ShortDate
'Draw the text
for i = 0 to UBound(output)
rad = radius-i*radIncr
s.Bold = textBold(i)
s.FillColor = txtClr(i)
s.Text = output(i)
pTest.Graphics.Bold = s.Bold
'Get the half-width and half-height of the unrotated text
w = pTest.Graphics.StringWidth(s.Text)/2
h = pTest.Graphics.StringHeight(s.Text,10000)/2
'Locate the text origin
x = (rad-h)*cos(angle)+xOrigin-cos(txtRot)*w
y = (rad-h)*sin(angle)+yOrigin+sin(txtRot)*w
g.DrawObject(s,x,g.height-y)
next
End Sub
And this is the revised original fanchart subroutine, along with subroutine AddToFam which retrieves the data from the family tree structure:
Public Sub Fanchart(gg As Graphics, size As Integer,depth As Integer, p As Person)
'Input parameters:
' Depth - number of concentric rings not counting the inner one
' i.e., the depth of family tree to be displayed
' Size - the radius of the overall chart in pixels
' (Text size is automatically scaled to the chart size)
dim x1,y1,x2,y2,radiusStart,radiusInitial,radiusIncr,pen As Integer
dim xOrigin,yOrigin,i,j,k As Integer
dim angle,InnerRatio As Double
dim arc As new ArcShape
Const pi=3.14159265358979
'The following scaled up picture is used temporarily
' to mitigate Object2D grainy resolution problems
' 4x may be a bit excessive, but it looks nice :-)
dim scalePic As new Picture(gg.Width*4,gg.Height*4)
dim g As Graphics = scalePic.graphics
'Probably the most convenient way to get text from
' family tree structure is to transfer it to an array.
' so that it is arranged in fan chart node order.
dim family() As Person
ReDim family(2^(depth+1)-1)
'Fill out the array recursively starting with person 'p'
' the person at the centre of the fanchart
AddToFam(p,1,family)
'Graphics setup stuff
pen=3
g.ForeColor=&c000000
g.PenHeight=pen
g.PenWidth=pen
'Adjust the origin to suit. These determine the centre of the semicircle
' as measured from the bottom left side of the canvas.
xOrigin=g.width\\2
yOrigin=50
arc.ArcAngle = pi
arc.StartAngle = -pi
arc.Fill=0
arc.Border=100
arc.BorderWidth=pen
arc.Segments=128
InnerRatio=0.8 'Allows radius of inner semicircle to be different than the others
radiusIncr=size/(depth+InnerRatio)
radiusInitial=radiusIncr*InnerRatio
'Draw outer arc
arc.Height=size*2
arc.Width=size*2
g.DrawObject(arc, xOrigin,g.height-yOrigin)
'Draw base line
g.DrawLine(xorigin-radiusInitial-depth*radiusIncr,g.height-yOrigin,_
xorigin+radiusInitial+depth*radiusIncr,g.height-yOrigin)
dim NodeNumber As Integer = 1
'Node 1 text
angle=pi/2
DrawNodeText(g,xOrigin,yOrigin,NodeNumber,family(NodeNumber),_
0.9*radiusInitial,0.12*radiusIncr,angle,size*0.02)
'Draw remaining arcs, radials, text
for i=1 to depth
radiusStart = radiusInitial+(i-1)*radiusIncr
arc.Height=radiusStart*2
arc.Width=radiusStart*2
g.DrawObject(arc, xOrigin,g.height-yOrigin)
k=2^i
'Draw radial lines
for j = 1 to k-1 step 2
angle=pi*j/k
x1=radiusStart*cos(angle)+xOrigin
y1=radiusStart*sin(angle)+yOrigin
x2=size*cos(angle)+xOrigin
y2=size*sin(angle)+yOrigin
g.DrawLine(x1,g.height-y1,x2,g.height-y2)
next
'Draw text
for j=k-1 downto 0
NodeNumber=NodeNumber+1
angle=pi*(j+0.5)/(k)
DrawNodeText(g,xOrigin,yOrigin,NodeNumber,family(NodeNumber),_
radiusStart+0.9*radiusIncr,0.15*radiusIncr,angle,size*0.02)
next
next
gg.DrawPicture(scalePic,0,0,gg.Width,gg.Height,0,0,g.Width,g.Height)
End Sub
Public Sub AddToFam(p As Person,index As Integer,fam() As person)
'Recursively fills the family array for the fan chart
if index>UBound(fam) then return
fam(index)=p
if p.father <> Nil then addToFam(p.father,index*2,fam)
if p.Mother <> Nil then addToFam(p.mother,index*2+1,fam)
End Sub
Caveat: I’ve only tested this on a Mac (OSX 10.10.5). I don’t expect any platform specific issues, but you never know.
