Questo sito utilizza cookies, anche di terze parti, per mostrare pubblicitÓ e servizi in linea con il tuo account. Leggi l'informativa sui cookies.
Username: Password: oppure
Calcolatrice con input da mouse - calc.pas

calc.pas

Caricato da: Leodema98
Scarica il programma completo

  1. Program calc;
  2. uses crt,mouse,sysutils;
  3.  
  4. var r,sim:char;
  5.     g:byte;
  6.     a,b,res:real;
  7.  
  8.  
  9. procedure init_mouse;
  10. var i:byte;
  11.  
  12. begin                              (*inizializza il mouse*)
  13.   initmouse;
  14.   i:=detectmouse;
  15.   if i=0 then
  16.     begin
  17.     donemouse;
  18.     writeln('ERRORE')
  19.     end
  20.          else
  21.     setmousexy(0,0)
  22. end;
  23.  
  24.  
  25. procedure write_calc;
  26.  
  27. begin                               (*output della calcolatrice*)
  28.   gotoxy(2,1);
  29.   write('CALCOLATRICE');
  30.   gotoxy(1,5);
  31.   writeln('┌───┐┌───┐┌───┐┌───┐');
  32.   writeln('│AC ││ESC││ ÷ ││ x │');
  33.   writeln('└───┘└───┘└───┘└───┘');
  34.   writeln('┌───┐┌───┐┌───┐┌───┐');
  35.   writeln('│ 7 ││ 8 ││ 9 ││ - │');
  36.   writeln('└───┘└───┘└───┘└───┘');
  37.   writeln('┌───┐┌───┐┌───┐┌───┐');
  38.   writeln('│ 4 ││ 5 ││ 6 ││ + │');
  39.   writeln('└───┘└───┘└───┘└───┘');
  40.   writeln('┌───┐┌───┐┌───┐┌───┐');
  41.   writeln('│ 1 ││ 2 ││ 3 ││   │');
  42.   writeln('└───┘└───┘└───┘│   │');
  43.   writeln('┌────────┐┌───┐│   │');
  44.   writeln('│ 0      ││ . ││ = │');
  45.   writeln('└────────┘└───┘└───┘')
  46. end;
  47.  
  48.  
  49. function readall:char;
  50. var x,y:byte;
  51.     eventi:tmouseevent;
  52.  
  53. begin                              (*input del mouse*)
  54.   readall:='?';
  55.   repeat
  56.     getmouseevent(eventi);
  57.     for x:=1 to 10 do
  58.       for y:=17 to 19 do
  59.         begin
  60.         if (eventi.buttons=1) and (eventi.x=x) and (eventi.y=y) then
  61.           readall:='0'
  62.         end;
  63.     for x:=1 to 5 do
  64.       for y:=14 to 16 do
  65.         begin
  66.         if (eventi.buttons=1) and (eventi.x=x) and (eventi.y=y) then
  67.           readall:='1'
  68.         end;
  69.     for x:=6 to 10 do
  70.       for y:=14 to 16 do
  71.         begin
  72.         if (eventi.buttons=1) and (eventi.x=x) and (eventi.y=y) then
  73.           readall:='2'
  74.         end;
  75.     for x:=11 to 15 do
  76.       for y:=14 to 16 do
  77.         begin
  78.         if (eventi.buttons=1) and (eventi.x=x) and (eventi.y=y) then
  79.           readall:='3'
  80.         end;
  81.     for x:=1 to 5 do
  82.       for y:=11 to 13 do
  83.         begin
  84.         if (eventi.buttons=1) and (eventi.x=x) and (eventi.y=y) then
  85.           readall:='4'
  86.         end;
  87.     for x:=6 to 10 do
  88.       for y:=11 to 13 do
  89.         begin
  90.         if (eventi.buttons=1) and (eventi.x=x) and (eventi.y=y) then
  91.           readall:='5'
  92.         end;
  93.     for x:=11 to 15 do
  94.       for y:=11 to 13 do
  95.         begin
  96.         if (eventi.buttons=1) and (eventi.x=x) and (eventi.y=y) then
  97.           readall:='6'
  98.         end;
  99.     for x:=1 to 5 do
  100.       for y:=8 to 10 do
  101.         begin
  102.         if (eventi.buttons=1) and (eventi.x=x) and (eventi.y=y) then
  103.           readall:='7'
  104.         end;
  105.     for x:=6 to 10 do
  106.       for y:=8 to 10 do
  107.         begin
  108.         if (eventi.buttons=1) and (eventi.x=x) and (eventi.y=y) then
  109.           readall:='8'
  110.         end;
  111.     for x:=11 to 15 do
  112.       for y:=8 to 10 do
  113.         begin
  114.         if (eventi.buttons=1) and (eventi.x=x) and (eventi.y=y) then
  115.           readall:='9'
  116.         end;
  117.     for x:=11 to 15 do
  118.       for y:=17 to 19 do
  119.         begin
  120.         if (eventi.buttons=1) and (eventi.x=x) and (eventi.y=y) then
  121.           readall:='.'
  122.         end;
  123.     for x:=16 to 20 do
  124.       for y:=11 to 13 do
  125.         begin
  126.         if (eventi.buttons=1) and (eventi.x=x) and (eventi.y=y) then
  127.           readall:='+'
  128.         end;
  129.     for x:=16 to 20 do
  130.       for y:=8 to 10 do
  131.         begin
  132.         if (eventi.buttons=1) and (eventi.x=x) and (eventi.y=y) then
  133.           readall:='-'
  134.         end;
  135.     for x:=16 to 20 do
  136.       for y:=5 to 7 do
  137.         begin
  138.         if (eventi.buttons=1) and (eventi.x=x) and (eventi.y=y) then
  139.           readall:='*'
  140.         end;
  141.     for x:=11 to 15 do
  142.       for y:=5 to 7 do
  143.         begin
  144.         if (eventi.buttons=1) and (eventi.x=x) and (eventi.y=y) then
  145.           readall:='/'
  146.         end;
  147.     for x:=16 to 20 do
  148.       for y:=14 to 19 do
  149.         begin
  150.         if (eventi.buttons=1) and (eventi.x=x) and (eventi.y=y) then
  151.           readall:='='
  152.         end;
  153.     for x:=1 to 5 do
  154.       for y:=5 to 7 do
  155.         begin
  156.         if (eventi.buttons=1) and (eventi.x=x) and (eventi.y=y) then
  157.           readall:='a'
  158.         end;
  159.     for x:=6 to 10 do
  160.       for y:=5 to 7 do
  161.         begin
  162.         if (eventi.buttons=1) and (eventi.x=x) and (eventi.y=y) then
  163.           readall:='e'
  164.         end
  165.   until readall<>'?';
  166.   case readall of
  167.     '0': g:=1;
  168.     '1': g:=1;
  169.     '2': g:=1;
  170.     '3': g:=1;
  171.     '4': g:=1;
  172.     '5': g:=1;
  173.     '6': g:=1;
  174.     '7': g:=1;
  175.     '8': g:=1;
  176.     '9': g:=1;
  177.     '.': g:=2;
  178.     '+': g:=3;
  179.     '-': g:=3;
  180.     '*': g:=3;
  181.     '/': g:=3;
  182.     '=': g:=4;
  183.     'a': g:=5;
  184.     'e': g:=6
  185.   end
  186. end;
  187.  
  188.  
  189. function trovanum:real;
  190. var i,l:byte;
  191.     n:array[1..18] of char;
  192.     nstr:string;
  193.  
  194. begin                         (*output dei numeri*)
  195.   for i:=1 to 18 do
  196.     n[i]:=' ';
  197.   gotoxy(2,3);
  198.   clreol;
  199.   while r='0' do
  200.     begin
  201.     n[1]:=r;
  202.     write(n[1]);
  203.     gotoxy(2,3);
  204.     r:=readall
  205.     end;
  206.   i:=0;
  207.   repeat
  208.     i:=i+1;
  209.     case g of
  210.       1:begin
  211.           n[i]:=r;
  212.           write(n[i])
  213.         end;
  214.       2:begin
  215.           if i=1 then
  216.             begin
  217.             n[i]:='0';
  218.             write(n[i]);
  219.             i:=i+1;
  220.             n[i]:=r;
  221.             write(n[i])
  222.             end
  223.                         else
  224.             begin
  225.             n[i]:=r;
  226.             write(n[i])
  227.             end;
  228.           l:=0;
  229.           repeat
  230.             l:=l+1;
  231.             repeat
  232.               r:=readall
  233.             until g<>2;
  234.             case g of
  235.               1:begin
  236.                   n[i+l]:=r;
  237.                   write(n[i+l])
  238.                 end;
  239.               3:begin
  240.                   sim:=r;
  241.                   break
  242.                 end;
  243.               4..5:break;
  244.               6:halt
  245.             end
  246.           until (i+l)=18;
  247.           break
  248.         end;
  249.       3:begin
  250.           sim:=r;
  251.           break
  252.         end;
  253.       4..5:break;
  254.       6:halt
  255.     end;
  256.     r:=readall
  257.   until i=18;
  258.   if n[i+l]='.' then
  259.     n[i+l]:=' ';
  260.   nstr:=concat(n[1],n[2],n[3],n[4],n[5],n[6],n[7],n[8],n[9],n[10],n[11],n[12],n[13],n[14],n[15],n[16],n[17],n[18]);
  261.   trovanum:=strtofloat(nstr)
  262. end;
  263.  
  264.  
  265. function trovares:real;
  266. var rstr:string;
  267.  
  268. begin                              (*output del risultato*)
  269.   case sim of
  270.     '+':trovares:=a+b;
  271.     '-':trovares:=a-b;
  272.     '*':trovares:=a*b;
  273.     '/':trovares:=a/b
  274.   end;
  275.   gotoxy(2,3);
  276.   clreol;
  277.   rstr:=floattostr(trovares);
  278.   write(rstr)
  279. end;
  280.  
  281.  
  282. procedure tutto;
  283.  
  284. begin                              (*tutto*)
  285.   if (g=1) or (g=2) or (g=4) then
  286.     begin
  287.     repeat
  288.       r:=readall;
  289.       if g=3 then
  290.         sim:=r
  291.     until (g=3) or (g=5) or (g=6)
  292.     end;
  293.   repeat
  294.     if (g<>5) and (g<>6) then
  295.       begin
  296.       repeat
  297.         r:=readall;
  298.         if g=3 then
  299.           sim:=r
  300.       until (g=1) or (g=2) or (g=5) or (g=6)
  301.       end;
  302.     case g of
  303.       1..2:begin
  304.              b:=trovanum;
  305.              if b=0 then
  306.                begin
  307.                gotoxy(2,3);
  308.                clreol;
  309.                write('IMPOSSIBILE');
  310.                repeat
  311.                  r:=readall
  312.                until (g=1) or (g=2) or (g=5) or (g=6);
  313.                break
  314.                end;
  315.              case g of
  316.                1..2:begin
  317.                       repeat
  318.                         r:=readall
  319.                       until (g=3) or (g=4) or (g=5) or (g=6);
  320.                       case g of
  321.                         3:begin
  322.                             res:=trovares;
  323.                             sim:=r;
  324.                             a:=res
  325.                           end;
  326.                         4:begin
  327.                             res:=trovares;
  328.                             repeat
  329.                               r:=readall;
  330.                               case g of
  331.                                 3:begin
  332.                                     a:=res;
  333.                                     sim:=r
  334.                                   end;
  335.                                 4:begin
  336.                                     a:=res;
  337.                                     res:=trovares
  338.                                     end;
  339.                                 6:halt
  340.                               end
  341.                             until (g=1) or (g=2) or (g=3) or (g=5);
  342.                             if g<>3 then
  343.                               break
  344.                           end;
  345.                         5:break;
  346.                         6:halt
  347.                       end
  348.                     end;
  349.                3:begin
  350.                    res:=trovares;
  351.                    sim:=r;
  352.                    a:=res
  353.                  end;
  354.                4:begin
  355.                    res:=trovares;
  356.                    repeat
  357.                      r:=readall;
  358.                      case g of
  359.                        3:begin
  360.                            sim:=r;
  361.                            a:=res
  362.                          end;
  363.                        4:begin
  364.                            a:=res;
  365.                            res:=trovares
  366.                          end;
  367.                        6:halt
  368.                      end
  369.                    until (g=1) or (g=2) or (g=3) or (g=5);
  370.                    if g<>3 then
  371.                      break
  372.                  end;
  373.                5:break;
  374.                6:halt
  375.              end
  376.            end;
  377.       5:break;
  378.       6:halt
  379.     end
  380.   until keypressed
  381. end;
  382.  
  383.  
  384.  
  385. begin                              (*programma*)
  386.   clrscr;
  387.   cursoroff;
  388.   init_mouse;
  389.   decimalseparator:='.';
  390.   write_calc;
  391.   gotoxy(2,3);
  392.   write('0');
  393.   r:=readall;
  394.   repeat
  395.     case g of
  396.       1..2:begin
  397.              a:=trovanum;
  398.              tutto
  399.            end;
  400.       3:begin
  401.           sim:=r;
  402.           a:=0;
  403.           tutto
  404.         end;
  405.       4:r:=readall;
  406.       5:begin
  407.           gotoxy(2,3);
  408.           clreol;
  409.           write('0');
  410.           r:=readall;
  411.           end;
  412.       6:halt
  413.     end
  414.   until keypressed;
  415.   donemouse
  416. end.