esercitazione con pascal su gruppo sanguigno AB0
interattivo

vedi videoclip

http://www.youtube.com/watch?v=zzVIvwCpmBI


 

program sangue;
uses crt;
var a,b,c:char;
    s:string;
    esatte,errate,fn,fg:integer;

procedure pausa;
begin
readln;
end;

procedure cancella;
begin
clrscr;
end;

procedure s1(a:char);
begin
gotoxy(5,3);writeln('genitori omozigotici per carattere ');
gotoxy(5,5);writeln('fenotipo genitori');
gotoxy(30,5);writeln(a);
gotoxy(50,5);writeln(a);
gotoxy(5,15);write('numero fenotipi nei figli ? ');readln(fn);
if fn=1 then begin writeln('esatto');esatte:=esatte+1;end
 else begin writeln('errato=era ',1);errate:=errate+1;end;
gotoxy(5,17);write('numero genotipi nei figli ? ');readln(fg);
if fg=1 then begin writeln('esatto');esatte:=esatte+1;end
 else begin writeln('errato=era ',1);errate:=errate+1;end;
gotoxy(5,9);writeln('fenotipo figli');
gotoxy(40,9);writeln(a);
pausa;
gotoxy(5,6);writeln('genotipo genitori');
gotoxy(30,6);writeln(a,a);
gotoxy(50,6);writeln(a,a);
gotoxy(5,7);writeln('gametogenesi');
gotoxy(30,7);writeln(a,s,a);
gotoxy(50,7);writeln(a,s,a);
gotoxy(5,10);writeln('genotipo figli');
gotoxy(40,10);writeln(a,a);
pausa;cancella;
end;

procedure s3(a,b:char);
begin
gotoxy(5,3);writeln('genitori omozigote,eterozigote ');
gotoxy(5,5);writeln('fenotipo genitori');
gotoxy(30,5);writeln(a,a);
gotoxy(50,5);writeln(a,b);
gotoxy(5,15);write('numero fenotipi nei figli ? ');readln(fn);
if fn=2 then begin writeln('esatto');esatte:=esatte+1;end
 else begin writeln('errato=era ',1);errate:=errate+1;end;
gotoxy(5,17);write('numero genotipi nei figli ? ');readln(fg);
if fg=2 then begin writeln('esatto');esatte:=esatte+1;end
 else begin writeln('errato=era ',1);errate:=errate+1;end;
gotoxy(5,9);writeln('fenotipo figli');
gotoxy(30,9);writeln(a,s,a);gotoxy(50,9);writeln(a,s,b);
pausa;
gotoxy(5,6);writeln('genotipo genitori');
gotoxy(30,6);writeln(a,a);
gotoxy(50,6);writeln(a,b);
gotoxy(5,7);writeln('gametogenesi');
gotoxy(30,7);writeln(a,s,a);
gotoxy(50,7);writeln(a,s,b);
gotoxy(5,10);writeln('genotipo figli');
gotoxy(30,10);writeln(a,a);gotoxy(50,10);writeln(a,b);
pausa;cancella;
end;

procedure s4(a,b:char);
begin
gotoxy(5,3);writeln('genitori eterozigote,eterozigote ');
gotoxy(5,5);writeln('fenotipo genitori');
gotoxy(30,5);writeln(a);
gotoxy(50,5);writeln(b);
gotoxy(5,15);write('numero fenotipi nei figli ? ');readln(fn);
if fn=4 then begin writeln('esatto');esatte:=esatte+1;end
 else begin writeln('errato=era ',1);errate:=errate+1;end;
gotoxy(5,17);write('numero genotipi nei figli ? ');readln(fg);
if fg=4 then begin writeln('esatto');esatte:=esatte+1;end
 else begin writeln('errato=era ',1);errate:=errate+1;end;
gotoxy(5,9);writeln('fenotipo figli');
gotoxy(30,9);writeln(a,b);gotoxy(50,9);writeln(a);
gotoxy(60,9);writeln(b);gotoxy(40,9);writeln(c);
pausa;
gotoxy(5,6);writeln('genotipo genitori');
gotoxy(30,6);writeln(a,c);
gotoxy(50,6);writeln(b,c);
gotoxy(5,7);writeln('gametogenesi');
gotoxy(30,7);writeln(a,s,c);
gotoxy(50,7);writeln(b,s,c);
gotoxy(5,10);writeln('genotipo figli');
gotoxy(30,10);writeln(a,b);gotoxy(50,10);writeln(a,c);
gotoxy(40,10);writeln(c,c);gotoxy(60,10);writeln(b,c);
pausa;cancella;
end;

procedure s5(a,b:char);
begin
gotoxy(5,3);writeln('genitori eterozigote,eterozigote ');
gotoxy(5,5);writeln('fenotipo genitori');
gotoxy(30,5);writeln(a);
gotoxy(50,5);writeln(b);
gotoxy(5,15);write('numero fenotipi nei figli ? ');readln(fn);
if fn=4 then begin writeln('esatto');esatte:=esatte+1;end
 else begin writeln('errato=era ',1);errate:=errate+1;end;
gotoxy(5,17);write('numero genotipi nei figli ? ');readln(fg);
if fg=4 then begin writeln('esatto');esatte:=esatte+1;end
 else begin writeln('errato=era ',1);errate:=errate+1;end;
gotoxy(5,9);writeln('fenotipo figli');
gotoxy(30,9);writeln(a);gotoxy(50,9);writeln(c);
pausa;
gotoxy(5,6);writeln('genotipo genitori');
gotoxy(30,6);writeln(a,c);
gotoxy(50,6);writeln(b,c);
gotoxy(5,7);writeln('gametogenesi');
gotoxy(30,7);writeln(a,s,c);
gotoxy(50,7);writeln(b,s,c);
gotoxy(5,10);writeln('genotipo figli');
gotoxy(30,10);writeln(a,b);gotoxy(50,10);writeln(a,c);
gotoxy(40,10);writeln(c,c);gotoxy(60,10);writeln(b,c);
pausa;cancella;
end;

procedure s2(a,b:char);
begin
gotoxy(5,3);writeln('genitori omozigotici per carattere ');
gotoxy(5,5);writeln('fenotipo genitori');
gotoxy(30,5);writeln(a);
gotoxy(50,5);writeln(b);
gotoxy(5,15);write('numero fenotipi nei figli ? ');readln(fn);
if fn=1 then begin writeln('esatto');esatte:=esatte+1;end
 else begin writeln('errato=era ',1);errate:=errate+1;end;
gotoxy(5,17);write('numero genotipi nei figli ? ');readln(fg);
if fg=1 then begin writeln('esatto');esatte:=esatte+1;end
 else begin writeln('errato=era ',1);errate:=errate+1;end;
gotoxy(5,9);writeln('fenotipo figli');
gotoxy(40,9);writeln(a,b);
pausa;
gotoxy(5,6);writeln('genotipo genitori');
gotoxy(30,6);writeln(a,a);
gotoxy(50,6);writeln(b,b);
gotoxy(5,7);writeln('gametogenesi');
gotoxy(30,7);writeln(a,s,a);
gotoxy(50,7);writeln(b,s,b);
gotoxy(5,10);writeln('genotipo figli');
gotoxy(40,10);writeln(a,b);
pausa;cancella;
end;

procedure programmi;
begin
s1(a);s1(b);s1(c);
s2(a,b);s2(a,c);s2(b,c);s2(c,c);
s3(a,b);s3(b,a);s5(a,b);s4(a,b);
pausa;
end;

begin
cancella;
a:='A';b:='B';c:='0';s:=' / ';
writeln('esempio trasmissione carattere gruppo sanguigno ABO ');
writeln('A codominante  ,B codominante , 0 recessivo ');
writeln('vengono proposti vari fenotipi dei genitori');
writeln('si richiede di scrivere numero di fenotipi e genotipi');
writeln('possibili nei figli');
writeln('si conferma o corregge la risposta ');
writeln('si rappresentano i vari fenotipi e genotipi ');
pausa;cancella;
programmi;
end.

 

 

 

 

 

indice o inizio