[marcoszorrilla]

Prueba esta función, la acabo de crear, por lo que te pido que me digas si va correctamente:

Function HowManyWeeks(dFecha:Tdate):Integer;
var
nAnno,nMes,nDia:Word;
nDiaUno:Integer;
begin

DecodeDate(dfecha,nAnno,nMes,nDia);
nDia:=1;

nDiaUno:=DayOfWeek(Encodedate(nAnno,nMes,nDia))-1;
  if (nMes = 1) or (nMes = 3) or (nMes = 5) or (nMes = 7) or (nMes = 8) or (nMes = 10) or (nMes = 12) then
    if nDiauno > 5 then
    Result:=6
    else
    Result:=5
  else if (nMes = 4) or (nMes = 6) or (nMes = 9) or (nMes = 11)then
    if nDiaUno = 7 then
    Result:=6
    else
    Result:=5
  else if nMes = 2 then
    if Not IsLeapYear(nAnno) And (nDiaUno = 1) then
    Result:=4
    else
    Result:=5;


end;

Un Saludo.