genetica gruppi sanguigni

programmi scritti con turbo pascal v.5-7 e compilati come file.exe
non essendo accettati i file.exe in rete (per pericolo virus) attivo il file.exe
e riprendo con digitale:copio incollo alcune videate e creo videoclip che
registro e poi richiamo con youtube

fornisco listato pascal per eventuale copia-incolla se pascal installato sul PC

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.

indice