function CalcKeySumm(Tree: SS): Integer;
begin
 if Tree = nil then
 begin
   CalcKeySumm := 0;
 end else
 begin
   CalcKeySumm := Tree^.Key + CalcKeySumm(Tree^.Left) + CalcKeySumm(Tree^.Right);
 end;
end;

type
 PTree = ^TTree;
 TTree = record
   Info: string;
   Count: Integer;
   Left,
   Right: PTree;
 end;

{ Функция добавления слова в дерево }
{ Если делать эту функцию рекурсивной и не принять мер }
{ то каждый раз при ее вызове строка будет дублироваться }
{ в стеке и произойдет переполнение стека. Хотя те }
{ компиляторы что поумнее передавать будут не строку, а }
{ указатель на строку. И переполнения не будет. Как }
{ BP не помню:( Ниже три варианта реализации этой функции }

{ Вариант добавления слова в дерево без рекурсии }
procedure AddItem(var ATree: PTree; AInfo: string);
 function MakeItem(AInfo: string): PTree;
 var
   P: PTree;
 begin
   P := nil;
   New(P);
   if P <> nil then
   begin
     P^.Info := AInfo;
     P^.Left := nil;
     P^.Right := nil;
     P^.Count := 1;
     P^.Info := AInfo;
   end;
   MakeItem := P;
 end;
var
 P: PTree;
begin
 if ATree = nil then
 begin
   ATree := MakeItem(AInfo);
   Exit;
 end;
 P := ATree;
 while P <> nil do
 begin
   if AInfo = P^.Info then
   begin
     P^.Count := P^.Count + 1;
     Exit;
   end;
   if AInfo < P^.Info then
   begin
     if P^.Left = nil then
     begin
       P^.Left := MakeItem(AInfo);
       Exit;
     end else
     begin
       P := P^.Left;
       Continue;
     end;
   end;
   if AInfo > P^.Info then
   begin
     if P^.Right = nil then
     begin
       P^.Right := MakeItem(AInfo);
       Exit;
     end else
     begin
       P := P^.Right;
       Continue;
     end;
   end;
 end;
end;

{ Вариант добавления слова в дерево с рекурсией }
{ Внешняя функция является как оболочкой для }
{ реальной функции. Реальная же не передает строку, }
{ а пользуется строкой-параметром оболочки. Сколько }
{ бы раз не вызывалась реальная функция строка не }
{ передается и переполнения стека не будет }
procedure AddItem(var ATree: PTree; AInfo: string);
 procedure Add(var ATree: PTree);
 begin
   if ATree = nil then
   begin
     New(ATree);
     if ATree <> nil then
     begin
       ATree^.Info := AInfo;
       ATree^.Count := 1;
       ATree^.Left := nil;
       ATree^.Count := nil;        
     end;
     Exit;
   end;
   if ATree^.Info = AInfo then
   begin
     ATree^.Count := ATree^.Count + 1;
     Exit;
   end;
   if AInfo < ATree^.Info then
     Add(ATree^.Left)
   else
     Add(ATree^.Right);
 end;
begin
 Add(ATree);
end;

{ Вариант добавления слова в дерево с рекурсией }
{ Самый простой:) В списке параметров перед параметром }
{ AInfo ставим var. Тем самым мы гарантируем что }
{ передаваться будет не строка, а указатель на нее }
{ По крайней мере так задумано... }
procedure AddItem(var ATree: PTree; var AInfo: string);
begin
 if ATree = nil then
 begin
   New(ATree);
   if ATree <> nil then
   begin
     ATree^.Info := AInfo;
     ATree^.Count := 1;
     ATree^.Left := nil;
     ATree^.Count := nil;        
   end;
   Exit;
 end;
 if ATree^.Info = AInfo then
 begin
   ATree^.Count := ATree^.Count + 1;
   Exit;
 end;
 if AInfo < ATree^.Info then
   AddItem(ATree^.Left, AInfo)
 else
   AddItem(ATree^.Right, AInfo);
end;

{ Функция проверки является ли слово палиндромом }
{ Палиндром это ведь когда слово читается слева }
{ направо так же как справа налево? }
function IsPalindrom(AWord: string): Boolean;
var
 I: Integer;
begin
 for I := 1 to Length(AWord) div 2 do
   if AWord[i] <> AWord[Length(AWord) - I + 1] then
   begin
     IsPalindrom := False;
     Exit;
   end;
 IsPalindrom := True;
end;

{ Собственно подсчет палиндромов }
function CalcPalindromCount(ATree: Ptree): Integer;
var
 N: Integer;
begin
 if ATree = nil then
 begin
   CalcPalindromCount := 0;
   Exit;
 end;
 if IsPalindrom(ATree^.Info) then
   N := ATree^.Count { если копии палиндромов не считать то N := 1 }
 else
   N := 0;
 CalcPalindromCount := N + CalcPalindromCount(ATree^.Left)
                         + CalcPalindromCount(ATree^.Right);
end;

{ Очистка дерева }
procedure Clear(var ATree: PTree);
begin
 if ATree <> nil then
 begin
   Clear(ATree^.Left);
   Clear(ATree^.Right);
   Delete(ATree);
   ATree := nil;
 end;
end;

подсчет в дереве А вершин уровня К:
если корень дерева не существует, то вернуть 0
если К=0, то вернуть 1
иначе вернуть (подсчет в левой ветке вершин уровня К-1)+(подсчет в правой ветке вершин уровня К-1)