<%[ ' The code for this report is written in VBScript as a sample template. ' This version supports the Ahnentafel numbering system. See http://en.wikipedia.org/wiki/Ahnentafel for details. ' Like all the reports, you are welcome to modify the code to suit your needs. ' JC Guasp 05-Jul-2008. ]%> <%[ Dim strTextXML, nstrStart, nstrStart2, nstrEnd, strInd, e, i strTextXML = ReportGenerator.Document.GetTextXML nstrStart = InStr(strTextXML,"") + 11 nstrEnd = InStr(strTextXML,"") If (nstrEnd = 0) Then ' if no selected individual Report.LogError Dic("Msg1") + Dic("Msg2") Report.AbortReport End If nstrStart2 = InStrRev(strTextXML,"") + 11 If (nstrStart2 <> nstrStart) Then ' if several Individuals selected in different genomaps Report.LogError Dic("Msg1") + Dic("Msg3") + Dic("Msg4") Report.AbortReport End If strInd = Mid(strTextXML, nstrStart, nstrEnd - nstrStart) If (InStr(strInd, ", ind") > 0 Or InStr(strInd, "fam") > 0 Or InStr(strInd, "entity") > 0) Then ' if several Inds, fam or entity Report.LogError Dic("Msg1") + Dic("Msg3") + Dic("Msg4") Report.AbortReport End If Set ColInd = ReportGenerator.Document.Collection("AllIndividuals") For Each e in ColInd If e.ID = strInd Then Set i = e End If Next Report.WriteFormattedLn "{}", Dic.FormatPhrase("HeadingAncestors", i.Name) If (i.Mother.Name<>"" Or i.Father.Name<>"") Then Public nGeneQty, nLevelPrev, nLevelPrevFM, nLevelHist, strBorn, strDead, strMadep Dim Ancestors, iKeyLast, j, nLevel, nLevelFM, nLevelNo, o, oEntry, oName, strEntryKey, strLevelTit strBorn = "" strDead = "" nGeneQty = 0 nLevelPrev = -1 nLevelPrevFM = "" aLevelTit = Array("",Dic("Parents"), Dic("GrandParents"), Dic("GreatGrandParents")) Const clrLevelTit = "#0000cd" ' mediumblue ' color used for parents, grandparents, ... titles Set Ancestors = Util.NewObjectRepertory SetAncestor i, Ancestors, "" Ancestors.SortByKey() iKeyLast = Ancestors.Count - 1 For iKey = 0 To iKeyLast Set oEntry = Ancestors.Entry(iKey) strEntryKey = oEntry.Key nLevel = CInt(Left(strEntryKey,(InStr(strEntryKey,"*")-1))) nLevelFM = Mid(oEntry.Key, InStr(oEntry.Key,"*")+1,1) nLevelNo = 0 ConvertToDec oEntry.Key, nLevelNo For Each o In oEntry Set oName = o Next WriteLevel nLevelNo, nLevel, oName, nLevelFM ' write parents, grandparents, ... titles Next Report.WriteFormattedLn "
{}", Dic.FormatPhrase("FmtAncestorsGeneQty", nGeneQty+1) Else Report.LogError Dic("Msg1") + Dic("Msg5") Report.AbortReport End If ' ------------------------------------------------------------------------------------------------------------- Function SetAncestor(i, Ancestors, p) strMadep = (Right(CStr(Len(p)+1000),3) + "*" + p) If (Len(p) > nGeneQty) Then nGeneQty = Len(p) End If Ancestors.Add strMadep, i If Not Util.IsNothing(i.Father) Then SetAncestor i.Father, Ancestors, p & "0" If Not Util.IsNothing(i.Mother) Then SetAncestor i.Mother, Ancestors, p & "1" End Function ' ------------------------------------------------------------------------------------------------------------- Function WriteLevel(nLevelNo, nLevel, oName, nLevelFM) strBorn = Util.IfElse(oName.Birth.Date.ToStringNarrative <> "" Or oName.Birth.Place <> ""," - "+Dic("BirthAbbr")+" ", "") strDead = Util.IfElse(oName.Death.Date.ToStringNarrative <> "" Or oName.Death.Place <> ""," - "+Dic("DiedAbbr")+" ", "") If (nLevel < 4) Then If (nLevelPrev <> nLevel) Then strLevelTit = HtmlColorString(aLevelTit(nLevel), clrLevelTit) Report.WriteFormattedBr "{0}", strLevelTit nLevelPrev = nLevel nLevelPrevFM="" End If If (nLevel > 1 And nLevelPrevFM <> nLevelFM) Then WriteFMSide(nLevelFM) End If Else If (nLevelPrev <> nLevel) Then strLevelTit = HtmlColorString(Trim(CStr(nLevel-2)) + " x " + aLevelTit(3), clrLevelTit) Report.WriteFormattedBr "{0}", strLevelTit nLevelPrev = nLevel nLevelPrevFM="" End If If (nLevelPrevFM <> nLevelFM) Then WriteFMSide(nLevelFM) End If End If If Not Util.IsNothing(oName.Father) Then oName.Father.Session("lineage") = " [→" & CStr(nLevelNo) & ".]" If Not Util.IsNothing(oName.Mother) Then oName.Mother.Session("lineage") = " [→" & CStr(nLevelNo) & ".]" If Not Util.IsNothing(oName.Father) And Not Util.IsNothing(oName.Mother) Then oName.Father.Session("union") = "┌ " oName.Mother.Session("union") = "└ " oName.Mother.Session("lineage") = "" End If If oName.Session("union") = "┌" And Len(CStr(iKey+1)) < Len(CStr(iKey+2)) Then oName.Session("union") = "  ┌" Report.WriteFormattedBr "{0}. {9}{1&t}{8} {2}{3&t} {4&t}{5}{6&t} {7&t}", (nLevelNo), oName,_ strBorn, oName.Birth.Date, oName.Birth.Place,_ strDead, oName.Death.Date, oName.Death.Place,_ Util.IfElse(iKey > 0, oName.Session("lineage"), ""), oName.Session("union") End Function ' ----------------------------------------------------------------------------------------------------------- Function WriteFMSide(nLevelFM) If (nLevelFM = "0") Then Report.WriteFormattedBr "{}", Dic("FatherSide") Else Report.WriteFormattedBr "{}", Dic("MotherSide") End If nLevelPrevFM = nLevelFM End Function '------------------------------------------------------------------------------------------------------------ Function HtmlColorString(strString, strColor) HtmlColorString = "
" + strString + "" End Function ' ----------------------------------------------------------------------------------------------------------- Function ConvertToDec(oEntryKey, nLevelNo) strLevelNo = "1" + Right(oEntryKey, (Len(oEntryKey)-InStr(oEntryKey,"*"))) For j = len(strLevelNo) to 1 step -1 strDigit = mid(strLevelNo, j, 1) If strDigit = "1" Then nLevelNo = nLevelNo + (2 ^ (len(strLevelNo)-j)) End If Next End Function ]%>