here is my code :



var
  xx               :array[0..32]of byte;
  Pb               :array[0..32]of longint;
  d                :array[1..32,0..20]of longint;
  x,y,m,k,b,I,J,num:longint;
  Ans,ki           :longint;

function c(x,y:integer):longint;
var
  ans,i:longint;
begin
  ans:=1;
  if y<x-y then
    y:=x-y;
  for I:=y+1 to x do
    ans:=ans*I;
  for I:=1 to x-y do
    ans:=ans div i;
  c:=ans;
end;

procedure solve(x,y:integer);
begin
  if xx[i]>1 then
    d[i,j]:=2*c(i-1,j)
  else
  if xx[i]=1 then
    d[i,j]:=c(i-1,j)+d[i-1,j-1]
  else
    d[I,J]:=d[I-1,J];
end;

begin
  read(y);read(x);read(ki);read(b);
  if y>x then
  begin m:=x;x:=y;y:=m; end;


  m:=x;
  while m>0 do
  begin
    inc(xx[0]);
    xx[xx[0]]:=m mod b;
    m:=m div b;
  end;

  Pb[0]:=1;
  for I:=1 to xx[0] do
    Pb[I]:=Pb[I-1]*b;

  if xx[1]>0 then d[1,0]:=1;
  if xx[1]>1 then
    d[1,1]:=1
  else
    d[1,1]:=0;

  for I:=2 to xx[0] do
    for J:=0 to Ki do
      solve(i,j);

  ans:=d[xx[0],ki];
  j:=0;
  for I:=1 to xx[0] do
    if xx[i]=1 then inc(j);
  if j=ki then inc(ans);

  fillchar(xx,sizeof(xx),0);
  m:=y;xx[0]:=0;
  while m>0 do
  begin
    inc(xx[0]);
    xx[xx[0]]:=m mod b;
    m:=m div b;
  end;

  fillchar(d,sizeof(d),0);

  if xx[1]>0 then d[1,0]:=1;

  if xx[1]>1 then
    d[1,1]:=1
  else
    d[1,1]:=0;

  for I:=2 to xx[0] do
    for J:=0 to Ki do
      solve(i,j);

  writeln(ans-d[xx[0],Ki]);
end.

please help me
i realy don't know why it gets WA.
thanks
pooya
{pooyahat@yahoo.com}