Código de Pascal/Turbo Pascal - Operaciones aritméticas

Operaciones aritméticasgráfica de visualizaciones


Pascal/Turbo Pascal

estrellaestrellaestrellaestrellaestrella(1)
Publicado el 25 de Noviembre del 2002 por Román Dzul Calvillo
7.887 visualizaciones desde el 25 de Noviembre del 2002. Una media de 14 por semana
Operaciones aritméticas realizadas en Pascal. Calcula el área y el perímetro de tríangulos, rectángulos, pentágonos y círculos.

Versión 1
estrellaestrellaestrellaestrellaestrella(1)

Publicado el 25 de Noviembre del 2002gráfica de visualizaciones de la versión: Versión 1
7.888 visualizaciones desde el 25 de Noviembre del 2002. Una media de 14 por semana
estrellaestrellaestrellaestrellaestrella
estrellaestrellaestrellaestrella
estrellaestrellaestrella
estrellaestrella
estrella

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
program dcrpr01;
uses crt;
var
   acuta,acutp,acura,acurp,acupa,acupp,acuca,acucp:real;
   nf,nt,nr,np,nc:integer;
   salid:boolean;
   opcion,rk:char;
 
procedure triangulo;
 var
  pt,atr,mp,mpm,l1,l2,l3:real;
 begin
  clrscr;
  writeln('                                     Tri ngulo');
  writeln;
  write('Escribe el valor de A:');
  readln(l1);
  writeln;
  write('Escribe el valor de B:');
  readln(l2);
  writeln;
  write('Escribe el valor de C:');
  readln(l3);
  if ((l1<=0) or (l2<=0) or (l3<=0)) then begin
   writeln('Valor(es) no valido(s)');
   write('Presione cualquier tecla para continuar');
   rk:=readkey;
  end
  else begin
   pt:=l1+l2+l3;
   mp:=pt/2;
   mpm:=(mp*(mp-l1)*(mp-l2)*(mp-l3));
   if mpm<=0 then begin
    writeln('Valor(es) no valido(s), no corresponden a un tri ngulo');
    write('Presione cualquier tecla para continuar');
    rk:=readkey;
   end
   else begin
    atr:=sqrt(mpm);
    nf:=nf+1;
    nt:=nt+1;
    writeln('-------------------------------------------------------------------------------');
    write('No de figura procesada:tri ngulo  ');
    write('Per¡metro=',pt:4:2,'m  ');
    writeln('Superficie=',atr:4:2,'m2');
    acuta:=acuta+atr;
    acutp:=acutp+pt;
    write('Presione cualquier tecla para continuar');
    rk:=readkey;
   end;
  end;
 end;
 
procedure rectangulo;
 var
  pr,ar,br,hr:real;
 begin
  clrscr;
  writeln('                                    Rect ngulo');
  writeln;
  write('Escribe el valor de la base:');
  readln(br);
  writeln;
  write('Escribe el valor de la altura:');
  readln(hr);
  if ((hr<=0) or (br<=0)) then begin
   writeln('Valor(es) no valido(s)');
   write('Presione cualquier tecla para continuar');
   rk:=readkey;
  end
  else begin
   ar:=br*hr;
   pr:=2*(br+hr);
   nf:=nf+1;
   nr:=nr+1;
   writeln('-------------------------------------------------------------------------------');
   write('No de figura procesada:rect ngulo  ');
   write('Per¡metro=',pr:4:2,'m  ');
   writeln('Superficie=',ar:4:2,'m2');
   acura:=acura+ar;
   acurp:=acurp+pr;
   write('Presione cualquier tecla para continuar');
   rk:=readkey;
  end;
 end;
 
procedure pentagono;
 var
  pp,ap,ll:real;
 begin
  clrscr;
  writeln('                                    Pent gono');
  writeln;
  write('Escribe la longitud del lado:');
  readln(ll);
  if (ll<=0) then begin
   writeln('Valor(es) no valido(s)');
   write('Presione cualquier tecla para continuar');
   rk:=readkey;
  end
  else begin
   pp:=ll*5;
   ap:=(((5)*(ll*ll))/4)*((cos(pi/5))/(sin(pi/5)));
   nf:=nf+1;
   np:=np+1;
   writeln('-------------------------------------------------------------------------------');
   write('No de figura procesada:pent gono  ');
   write('Per¡metro=',pp:4:2,'m  ');
   writeln('Superficie=',ap:4:2,'m2');
   acupa:=acupa+ap;
   acupp:=acupp+pp;
   write('Presione cualquier tecla para continuar');
   rk:=readkey;
  end;
 end;
 
procedure circulo;
 var
  pc,ac,radio:real;
 begin
  clrscr;
  writeln('                                     C¡rculo');
  writeln;
  write('Escribe la longitud del radio:');
  readln(radio);
  if (radio<=0) then begin
   writeln('Valor(es) no valido(s)');
   write('Presione cualquier tecla para continuar');
   rk:=readkey;
  end
  else begin
   pc:=pi*(radio*2);
   ac:=pi*(radio*radio);
   nf:=nf+1;
   nc:=nc+1;
   writeln('-------------------------------------------------------------------------------');
   write('No de figura procesada:c¡rculo  ');
   write('Per¡metro:',pc:4:2,' m  ');
   writeln('Superficie:',ac:4:2,' m2');
   acuca:=acuca+ac;
   acucp:=acucp+pc;
   write('Presione cualquier tecla para continuar');
   rk:=readkey;
  end;
 end;
 
procedure salida;
 var
  raa,rap:real;
 procedure lineas;
 begin
  writeln('-------------------------------------------------------------------------------');
 end;
 begin
  clrscr;
  writeln('                                    Resultados');
  lineas;
  writeln('Figura       |  procesados   |    subper¡metros    |     subsuperficies');
  lineas;
  writeln('Tri ngulos        ',nt:2,'                  ',acutp:4:2,'                   ',acuta:4:2);
  writeln('Rect ngulos       ',nr:2,'                  ',acurp:4:2,'                   ',acura:4:2);
  writeln('Pent gonos        ',np:2,'                  ',acupp:4:2,'                   ',acupa:4:2);
  writeln('C¡rculos          ',nc:2,'                  ',acucp:4:2,'                   ',acuca:4:2);
  lineas;
  raa:=acuta+acura+acupa+acuca;
  rap:=acutp+acurp+acupp+acucp;
  writeln('Totales           ',nf:2,'                  ',rap:4:2,'                   ',raa:4:2);
  salid:=false;
  write('Presione cualquier tecla para continuar');
  rk:=readkey;
  clrscr;
 end;
 
procedure menu;
 begin
  clrscr;
  writeln('FIGURAS');
  writeln('Autor:Rom n Dzul Calvillo');
  writeln;
  writeln('T:Tri ngulo');
  writeln('R:Rect ngulo');
  writeln('P:Pent gono');
  writeln('C:C¡rculo');
  writeln('S:Salir');
  writeln;
  write('Pulse una opci¢n:');
  repeat
   opcion:=readkey;
   if  opcion=#0 then
    opcion:=readkey;
    opcion:=upcase(opcion);
  until opcion in ['T','R','P','C','S'];
 end;
 
begin
 clrscr;
 nf:=0;
 nt:=0;
 nr:=0;
 np:=0;
 nc:=0;
 acuta:=0;
 acutp:=0;
 acura:=0;
 acurp:=0;
 acupa:=0;
 acupp:=0;
 acuca:=0;
 acucp:=0;
 salid:=true;
 repeat
 menu;
 case opcion of
  'T':triangulo;
  'R':rectangulo;
  'P':pentagono;
  'C':circulo;
  'S':salida;
 end;
 until (salid=false);
end.



Comentarios sobre la versión: Versión 1 (1)

Patricia Velasco
17 de Octubre del 2008
estrellaestrellaestrellaestrellaestrella
Que emocion y ternura ver os pininos de mihermnito cosmico roman.... weeee gracias a dios has mejorado!!
Responder

Comentar la versión: Versión 1

Nombre
Correo (no se visualiza en la web)
Valoración
Comentarios

http://lwp-l.com/s372