Otra calculadora que igual tiene alguno que otro fallo (Esta evalua decimales)
program calculadora; uses Crt,Dos; Var cad:String[9]; a,limite,j,flag_1:Byte; sel,aux:Char; n1,n2:real; auxn1,auxn2,r:Real; time:byte; nada,kn,clean,punch:Boolean; y:integer; x:integer; Procedure cal; Var x,y:Byte; Begin y:=3; Textcolor(15); Textbackground(5); gotoxy(19-19,12-10); writeln(' '); gotoxy(19-19,13-10); writeln(' '); gotoxy(19-19,14-10); writeln(' 7 8 9 c '); gotoxy(19-19,15-10); writeln(' 4 5 6 - '); gotoxy(19-19,16-10); writeln(' 1 2 3 + '); gotoxy(19-19,17-10); writeln(' û 0 ý / '); gotoxy(19-19,18-10); writeln(' <- . ÿ= *ÿ '); gotoxy(19-19,19-10); writeln(' '); End; Procedure colores; Var wait:Byte; x,y:byte; Begin Textcolor(15); Textbackground(5); y:=3; Textcolor(4); wait:=20; Case sel of #55: Begin Gotoxy(21-18,14-10); Write('7'); delay(50); Textcolor(15); Gotoxy(21-18,14-10); Write('7'); End; #56: Begin Gotoxy(26-18,14-10); Write('8'); delay(50); Textcolor(15); Gotoxy(26-18,14-10); Write('8'); End; #57: Begin Gotoxy(30-18,14-10); Write('9'); delay(50); Textcolor(15); Gotoxy(30-18,14-10); Write('9'); End; #67: Begin Gotoxy(34-18,14-10); Write('c'); delay(50); Textcolor(15); Gotoxy(34-18,14-10); Write('c'); End; #52: Begin Gotoxy(21-18,15-10); Write('4'); delay(50); Textcolor(15); Gotoxy(21-18,15-10); Write('4'); End; #53: Begin Gotoxy(26-18,15-10); Write('5'); delay(50); Textcolor(15); Gotoxy(26-18,15-10); Write('5'); End; #54: Begin Gotoxy(30-18,15-10); Write('6'); delay(50); Textcolor(15); Gotoxy(30-18,15-10); Write('6'); End; #45: Begin Gotoxy(34-18,15-10); Write('-'); delay(50); Textcolor(15); Gotoxy(34-18,15-10); Write('-'); End; #49: Begin Gotoxy(21-18,16-10); Write('1'); delay(50); Textcolor(15); Gotoxy(21-18,16-10); Write('1'); End; #50: Begin Gotoxy(26-18,16-10); Write('2'); delay(50); Textcolor(15); Gotoxy(26-18,16-10); Write('2'); End; #51: Begin Gotoxy(30-18,16-10); Write('3'); delay(50); Textcolor(15); Gotoxy(30-18,16-10); Write('3'); End; #43: Begin Gotoxy(34-18,16-10); Write('+'); delay(50); Textcolor(15); Gotoxy(34-18,16-10); Write('+'); End; #82: Begin Gotoxy(21-18,17-10); Write('û'); delay(50); Textcolor(15); Gotoxy(21-18,17-10); Write('û'); End; #48: Begin Gotoxy(26-18,17-10); Write('0'); delay(50); Textcolor(15); Gotoxy(26-18,17-10); Write('0'); End; #87: Begin Gotoxy(30-18,17-10); Write('ý'); delay(50); Textcolor(15); Gotoxy(30-18,17-10); Write('ý'); End; #47: Begin Gotoxy(34-18,17-10); Write('/'); delay(50); Textcolor(15); Gotoxy(34-18,17-10); Write('/'); End; #08: Begin Gotoxy(21-18,18-10); Write('<-'); delay(50); Textcolor(15); Gotoxy(21-18,18-10); Write('<-'); End; #46: Begin Gotoxy(26-18,18-10); Write('.'); delay(50); Textcolor(15); Gotoxy(26-18,18-10); Write('.'); End; #13: Begin Gotoxy(30-18,18-10); Write('='); delay(50); Textcolor(15); Gotoxy(30-18,18-10); Write('='); End; #42: Begin Gotoxy(34-18,18-10); Write('*'); delay(50); Textcolor(15); Gotoxy(34-18,18-10); Write('*'); End; End; End; Procedure limpiar; {Procedimiento para limpiar la pantalla} var y,x:byte; Begin Textcolor(15); Textbackground(5); y:=3; For a:=limite to 9 do cad[a]:=' '; Textcolor(5); Gotoxy(20-19,12-10); Write(' '); limite:=9; punch:=True; {Activar la colocacion del punto decimal} nada:=False; {Activar la alerta del Cero} clean:=False; {Avtivar el limpiado del Display} End; Procedure add; {Agregar caracteres} Begin Textcolor(15); Textbackground(5); If clean Then {Si clean es verdaderp.. limpia la pantalla} limpiar; If limite>0 Then {Si limite es mayor a 0, hacer} Begin If limite=9 Then {Condicion precaucion Cero} nada:=False; For j:=limite to 9 do Begin aux:=cad[j]; cad[j-1]:=aux; {Codigo encargado de agregar los caracteres al Display} cad[j]:=sel; End; limite:=limite-1; End End; Procedure cero; Begin Textcolor(15); Textbackground(5); If clean Then {Si clean es True, Limpiar Display} limpiar; If limite>0 Then {Si limite es mayor a 0, hacer} Begin If limite=9 Then {Codigo Precaucion cero} nada:=True; Begin For j:=limite to 9 do Begin aux:=cad[j]; cad[j-1]:=aux; {Codigo encargado de agregar los caracteres al Display} cad[j]:=sel; End; limite:=limite-1; {Decrementar el limite de la cadena} End; End; End; Procedure punto; {Procedimiento para controlar los puntos decimales} Begin Textcolor(15); Textbackground(5); If clean Then limpiar; If limite>0 Then Begin If punch Then Begin If limite=9 Then Begin cad[9]:='0'; {Codigo encargado de realizar} limite:=limite-1; {lo antes mensionado} End; For j:=limite to 9 do Begin aux:=cad[j]; cad[j-1]:=aux; {Codigo encargado de agregar los caracteres al Dislpay} cad[j]:=sel; End; limite:=limite-1; {Decrementar el limite de la cadena} punch:=False; {Activar point, para decir que ya tenemos un punto} End End End; Procedure del; {Procedimiento para eliminar un caracter del Display} Var auxlim:Byte; Begin Textcolor(15); Textbackground(5); If limite<9 Then {Si limite es menor a 9, hacer} Begin If limite=0 Then {Si limite es igual a 0, hacer} auxlim:=1 {Asignar a auxlim el valor de 1} Else {Si limite no es igual a 0, hacer} auxlim:=0; {Asiganr a auxlim el valor de 0} For j:=9 downto limite+auxlim do cad[j]:=cad[j-1]; {Ciclo para el borrado de un caracter} For j:=9 downto limite do Begin If cad[j]=#46 Then {Si existe un punto} Begin punch:=False; Break; End {No activar la bandera punch} Else {Si no existe el punto} punch:=True; {Activar la bandera point} End; limite:=limite+1; {Incrementar el limite de la cadena, ya que borramos un caracter} End End; Procedure convert; {Procedimiento para convertir la cadena a numero} Var ce,cd,c,limnew,aux,lol:Byte; { Variables auxiliares} inc:Longint; { utilizadas para la conversion} divo:Real; { de la cadena a numeros} Begin Textcolor(15); Textbackground(5); limnew:=limite+1; {Variable limite nuevo asignarle el limite de la cadena mas 1} auxn1:=0; auxn2:=0; {inicializar las variables para la convertios de enteros y decimales} For c:=9 downto limite do Begin If cad[c]=#46 Then {Si existe el punto decimal, hacer} Begin cd:=9-c; ce:=9-(limnew+cd); lol:=1; { saber cuantos enteros y decimales hay} break; End Else {Si no existe el punto decimal} If c=limite Then Begin ce:=9-limite; cd:=0; { Hacer el conteo de los enteros } lol:=0; End; End; inc:=1; For c:=9-(cd+lol) downto limite do Begin Case cad[c] of {aqui conocemos el valor de los enteros} '0': Begin aux:=0; auxn1:=auxn1+(aux*inc) end; '1': Begin aux:=1; auxn1:=auxn1+(aux*inc) end; '2': Begin aux:=2; auxn1:=auxn1+(aux*inc) end; '3': Begin aux:=3; auxn1:=auxn1+(aux*inc) end; '4': Begin aux:=4; auxn1:=auxn1+(aux*inc) end; '5': Begin aux:=5; auxn1:=auxn1+(aux*inc) end; '6': Begin aux:=6; auxn1:=auxn1+(aux*inc) end; '7': Begin aux:=7; auxn1:=auxn1+(aux*inc) end; '8': Begin aux:=8; auxn1:=auxn1+(aux*inc) end; '9': Begin aux:=9; auxn1:=auxn1+(aux*inc) end; End; inc:=inc*10; End; {aki es para obtener los decimales} inc:=10; For c:=9-(cd-1) to 9 do Begin divo:=1/inc; Case cad[c] of {esto es para conocer los valores numericos} '0': Begin aux:=0; auxn2:=auxn2+(aux*divo) end; '1': Begin aux:=1; auxn2:=auxn2+(aux*divo) end; '2': Begin aux:=2; auxn2:=auxn2+(aux*divo) end; '3': Begin aux:=3; auxn2:=auxn2+(aux*divo) end; '4': Begin aux:=4; auxn2:=auxn2+(aux*divo) end; '5': Begin aux:=5; auxn2:=auxn2+(aux*divo) end; '6': Begin aux:=6; auxn2:=auxn2+(aux*divo) end; '7': Begin aux:=7; auxn2:=auxn2+(aux*divo) end; '8': Begin aux:=8; auxn2:=auxn2+(aux*divo) end; '9': Begin aux:=9; auxn2:=auxn2+(aux*divo) end; End; inc:=inc*10; End; End; Procedure funciones; {procedimiento para las funciones aritmeticas} Var pivofun:Byte; Begin Textcolor(15); Textbackground(5); Case sel of #43: Begin {si presionamos al tecla de +, realiza lo siguiente} If limite<9 Then Begin convert; If kn Then Begin n1:=auxn1+auxn2; kn:=False; clean:=True; End Else Begin n2:=auxn1+auxn2; End; If n2<>0 Then Begin limpiar; r:=n1+n2; n1:=r; n2:=0; End; End; End; #45: Begin {Si presiona la tecla de + hace lo siguiente} If limite<9 Then Begin convert; If kn Then Begin n1:=auxn1+auxn2; kn:=False; clean:=True; End Else Begin n2:=auxn1+auxn2; End; If n2<>0 Then Begin limpiar; r:=n1-n2; n1:=r; n2:=0; End; End; End; #47: Begin {si presionamos la tecla de / hace lo siguiente..} If limite<9 Then Begin convert; If kn Then Begin n1:=auxn1+auxn2; kn:=False; clean:=True; End Else Begin n2:=auxn1+auxn2; End; If n2<>0 Then Begin limpiar; r:=n1/n2; n1:=r; n2:=0; End; End; End; #42: Begin {Si presionamos la tecla * realiza lo siguiente que es la multi..} If limite<9 Then Begin convert; If kn Then Begin n1:=auxn1+auxn2; kn:=False; clean:=True; End Else Begin n2:=auxn1+auxn2; End; If n2<>0 Then Begin limpiar; r:=n1*n2; n1:=r; n2:=0; End; End; End; #87: Begin {si presionamos la tecla barra hace lo siguiente, que es la potencia} If limite<9 Then Begin convert; limpiar; n1:=auxn1+auxn2; kn:=False; clean:=True; r:=sqr(n1); n1:=r; n2:=0; End Else Begin limpiar; r:=sqr(n1); n1:=r; End; End; #82: Begin {Si presionamos la tecla r hace lo siguiente.. raiz} If limite<9 Then Begin convert; limpiar; n1:=auxn1+auxn2; kn:=False; clean:=True; r:=sqrt(n1); n1:=r; End Else Begin limpiar; r:=sqrt(n1); n1:=r; End; End; #13: Begin {Si presionamos la tecla de enter, nos muestra el resultado} If limite<9 Then Begin Case flag_1 of {Conocer que funcion quedo pendiente} 1: Begin {Suma} convert; If kn Then Begin n1:=auxn1+auxn2; kn:=False; clean:=True; End Else Begin n2:=auxn1+auxn2; End; If n2<>0 Then Begin limpiar; r:=n1+n2; n1:=r; n2:=0; End; End; 2: Begin {Resta} convert; If kn Then Begin n1:=auxn1+auxn2; kn:=False; clean:=True; End Else Begin n2:=auxn1+auxn2; End; If n2<>0 Then Begin limpiar; r:=n1-n2; n1:=r; n2:=0; End; End; 3: Begin {Division} convert; If kn Then Begin n1:=auxn1+auxn2; kn:=False; clean:=True; End Else Begin n2:=auxn1+auxn2; End; If n2<>0 Then Begin limpiar; r:=n1/n2; n1:=r; n2:=0; End; End; 4: Begin {Multiplicacion} convert; If kn Then Begin n1:=auxn1+auxn2; kn:=False; clean:=True; End Else Begin n2:=auxn1+auxn2; End; If n2<>0 Then Begin limpiar; r:=n1*n2; n1:=r; n2:=0; End; End; End; End; End; End; If r<>0 Then {Si r es diferente de 0, hacer} Begin Textcolor(15); Textbackground(5); Gotoxy(26-19,12-10); Write(r:0:4); clean:=True; End; End; Begin Textcolor(15); Textbackground(0); Clrscr; {limpiar pantalla} punch:=True; nada:=False; kn:=True; clean:=False; limite:=9; time:=250; n1:=0; n2:=0; flag_1:=0; cal; {llama al procedimiento de cal} While sel<>#27 do {Ciclo general del Programa} Begin sel:=Upcase(Readkey); Textbackground(5); colores; Case sel of #49..#57: add; #48: cero; #46: punto; #08: del;{borrar el numero que no quieras} #43: Begin flag_1:=1; funciones; End; {En caso de suma} #45: Begin flag_1:=2; funciones; End; {En caso de resta} #47: Begin flag_1:=3; funciones; End; {En caso de division} #42: Begin flag_1:=4; funciones; End; {En caso de multiplicacion} #87: Begin flag_1:=5; funciones; End; {En caso de elevar al cuadrado} #82: Begin flag_1:=6; funciones; End; {En caso de sacar raiz} #13: Begin funciones; clean:=True; End; {En caso de dar igua} #67: Begin limpiar; flag_1:=0; r:=0; n1:=0; n2:=0; End; {En caso de Borrar Todo} End; Textcolor(15); Textbackground(5); If n2=0 Then Begin For a:=9 downto limite do Begin Gotoxy(a+25-19,12-10); Write(cad[a]); End; End; End; End.
Antes de comentar: Gran parte de los ejercicios propuestos no tienen librerías debido a que Wordpress las eliminó al verlas como etiquetas HTML. Si sabes/tienes/conoces las librerías que hacen falta, déjalo en los comentarios. Y lo mas importante: Todos los ejemplos fueron realizados por personas con únicamente conocimiento básico del lenguaje, no de programación.
Otro punto importante: Si vas a sugerir un segmento de código en algún lenguaje debes hacerlo así:
- Si es lenguaje C [c]Código en C[/c]
- Si es lenguaje Pascal [pascal]Aquí dentro el código de Pascal[/pascal].
De esta manera el código coloreas el código.
Otro punto importante para muchos que sienten que se les ignora: Todos los comentarios los reviso y en su debido momento los apruebo, pero ojo con el con lo siguiente:Me reservo el derecho de alterar, publicar o no los comentarios as´ como cambiar mis condiciones en el momento que así lo requiera.
¿estas de acuerdo? entonces adelante que ya te he quitado bastante tiempo leyendo esta basura de advertencias :)