Please, look my code, and give me some tricky tests if possible.
Thank's a lot for your help

Var
   A : Array [1..3,1..3] Of Byte;
   S : String;
   I,J : Integer;

Function XO (T : Integer) : Integer;
Var J,I,Kil,O,X,P : Integer;
Begin
Kil:=0;
For I:=1 To 3 Do Begin
O:=0;X:=0;P:=0;
For J:=1 To 3 Do If A[I,J]=0 Then Inc(O) Else If A[I,J]=1 Then Inc
(X) Else Inc(P);
If T=0 Then If (O=2) And (P=1) Then Inc(Kil);
If T=1 Then If (X=2) And (P=1) Then Inc(Kil);
End;

For I:=1 To 3 Do Begin
O:=0;X:=0;P:=0;
For J:=1 To 3 Do If A[J,I]=0 Then Inc(O) Else If A[J,I]=1 Then Inc
(X) Else Inc(P);
If T=0 Then If (O=2) And (P=1) Then Inc(Kil);
If T=1 Then If (X=2) And (P=1) Then Inc(Kil);
End;

O:=0;X:=0;P:=0;
For J:=1 To 3 Do If A[J,J]=0 Then Inc(O) Else If A[J,J]=1 Then Inc
(X) Else Inc(P);
If T=0 Then If (O=2) And (P=1) Then Inc(Kil);
If T=1 Then If (X=2) And (P=1) Then Inc(Kil);

O:=0;X:=0;P:=0;
For J:=1 To 3 Do If A[J,4-J]=0 Then Inc(O) Else If A[J,4-J]=1 Then
Inc(X) Else Inc(P);
If T=0 Then If (O=2) And (P=1) Then Inc(Kil);
If T=1 Then If (X=2) And (P=1) Then Inc(Kil);
XO:=Kil;
End;

Begin
For I:=1 To 3 Do Begin
Readln(S);
For J:=1 To Length(S) Do Begin
If S[J]='X' Then A[I,J]:=1;
If S[J]='#' Then A[I,J]:=2;
End;
End;

If XO(1)>=1 Then Begin Writeln('Crosses win');Halt;End;
If XO(0)>=2 Then Begin Writeln('Ouths win');Halt;End;
Writeln('Draw');
End.

Hello, Vitaly !!!
If you realy need a help mail me !!!
VRomanchik@tut.by