test su gruppo ABO

ritorna biologiaturbo.htm

program ABO1;
uses crt;
var feno:string[10];
s:char;
tipo:integer;
f:array[1..9] of string[10];
g:array[1..9] of string[10];
h:array[1..9] of string[10];

procedure gruppi;
begin
f[1]:='B,AB';f[2]:='A,AB';f[3]:='A,B,AB';f[4]:='0';f[5]:='';
f[6]:='B,AB';f[7]:='0';f[8]:='A,AB';f[9]:='0';
g[1]:='AB,B';g[2]:='AB,A';g[3]:='A,B,AB';g[4]:='0';g[5]:='';
g[6]:='AB,B';g[7]:='0';g[8]:='AB,A';g[9]:='0';
h[1]:='A,A';h[2]:='B,B';h[3]:='0,0';h[4]:='AB,AB';h[5]:='A,B';
h[6]:='A,0';h[7]:='A,AB';h[8]:='B,0';h[9]:='B,AB';

clrscr;
writeln('indicare fenotipo dei genitori,scrivendo il numero ');
writeln('----------------------------------------------------');
writeln('1...A,A');
writeln('2...B,B');
writeln('3...0,0');
writeln('4...AB,AB');
writeln('5...A,B');
writeln('6...A,0');
writeln('7...A,AB');
writeln('8...B,0');
writeln('9...B,AB');
writeln('-----------------------------------------------------');
write('fenotipo=');readln(tipo);
end;



procedure chiede;
begin
gruppi;
clrscr;
writeln('fenotipo genitori=',h[tipo]);
writeln('-------------------------------------------------');
writeln('indicare fenotipi non possibili nei figli ');
writeln('scrivendo le sigle separate da virgola ');
writeln('es.A,AB......0.....A,0..');
writeln('es.se sono 3 scrivere in ordine A,B,AB ');
writeln('es.se nessun fenotipo impossibile,premere INVIO ');
writeln('--------------------------------------------------');
writeln('fenotipi non possibili=');readln(feno);
if ((feno<>f[tipo]) and (feno<>g[tipo])) then writeln('errato:era :',f[tipo])
ELSE WRITELN('esatto');
writeln('--------------------------------------------------');
writeln('premi INVIO');
readln;clrscr;
writeln('scrivi S per altra prova,oppure N per finire');
write('scelta=');readln(s);
if ((s='S') or (s='s')) then chiede;
end;


begin
clrscr;
writeln;
writeln('GENETICA dei GRUPPI SANGUIGNI AB0 ');
writeln('esempio di fenotipi incompatibili nei figli');
writeln('in funzione dei fenotipi noti nei genitori');
writeln('-------------------------------------------');
writeln('ricordare che A e B sono codominanti e 0 recessivo');
writeln('premi ENTER');readln;
chiede;
end.