• Domingo 15 de Septiembre de 2019, 14:14

Mostrar Mensajes

Esta sección te permite ver todos los posts escritos por este usuario. Ten en cuenta que sólo puedes ver los posts escritos en zonas a las que tienes acceso en este momento.


Mensajes - epayan

Páginas: [1] 2
1
Pascal / Re: Funcion Imprimir
« en: Jueves 23 de Junio de 2011, 16:35 »
No , no es imposible, para todo hay una solucion, existe un programa, comercial que se llama Dos2Usb , que emula el puerto paralelo a cualquier impresora que tengas conectada , ya sea Usb o En red, pruebalo
ahora la instruccion para mandar a imprimir algo en pascal es la siguiente

 Writeln(Lst,"Hola Mundo");

claro haciendo uso de la unidad Printer.

2
Pascal / Re: elminacion de registros en archivo
« en: Domingo 3 de Abril de 2011, 03:29 »
aqui un code con los que requieres de archivos y registros y su tratamiento: alta, modificaciones, bajas fisicas, consultas y listados.

Código: Pascal
  1.  
  2.  
  3. program ejemplo_archivos;
  4. uses crt,dos,sysutils;
  5. {en este ejemplo se refleja  el uso de registros con archivos
  6. haciendo el uso de insercion, modificacion , y borrado fisico de los
  7. registros}
  8.  
  9. type
  10.       TipoRegistro = Record
  11.       Numero : Longint;
  12.       Nombre : String[40];
  13.       Direccion : String[40];
  14.       Telefono : String[10];
  15. End;
  16.  
  17. TipoArchivo = File Of TipoRegistro;
  18.  
  19. {*------|------|------|------|------|------|------|------|------|------|----*}
  20.  
  21. Procedure AperturaDeArchivo(var TArchivo:Tipoarchivo);
  22. var
  23.    Error: Word;
  24.    Tecla:Char;
  25. Begin
  26.     Assign(TArchivo,'c:Archivo.dat');
  27.    {$I-}
  28.    Reset(TArchivo);
  29.    Error:=IOResult;
  30.    {$I+}
  31.    If Error <> 0 Then
  32.       Begin
  33.               textattr:=14+4*16;
  34.               gotoxy(4,24);write('Creando Bases Temporal !! ');
  35.               rewrite(TArchivo);
  36.       End;
  37. End;
  38.  
  39. {*------|------|------|------|------|------|------|------|------|------|----*}
  40.  
  41. procedure AperturaDeArchivoTemporal(var TTmpAArchivo:TipoArchivo);
  42. var
  43.    Error: word;
  44.    Tecla:Char;
  45. Begin
  46.      Assign(TTmpAArchivo,'c:Archivo.Tmp');
  47.      {$I-}
  48.      Reset(TTmpAArchivo);
  49.      Error:=IOResult;
  50.      {$I+}
  51.      If Error <> 0 Then
  52.         Begin
  53.                textattr:=14+4*16;
  54.                 gotoxy(4,24);write('Creando Bases Temporal !! ');
  55.                 rewrite(TTmpAArchivo);
  56.         End;
  57. End;
  58.  
  59. {*------|------|------|------|------|------|------|------|------|------|----*}
  60.  
  61. function BuscaRegistro(Var AArchivo:tipoArchivo;Var TIRegistro:TipoRegistro;Numero:LongInt):longint;
  62. Var
  63.    Encontrado:longint;
  64. Begin
  65.        textattr:=14+4*16;
  66.        gotoxy(4,24);write('Buscando Registro..');
  67.        Encontrado :=-1; {inicializamos Encontrado a -1, valor inexistente}
  68.        Seek(AArchivo,0); {Posicionamos al inicio el puntero del archivo}
  69.        While not EOF(AArchivo) do {iniciamos ciclode recorrido del archivo}
  70.         Begin
  71.               Read(AArchivo,TIRegistro); {Leemos el Registro segun posicion del puntero}
  72.               IF TIRegistro.Numero = Numero then{Comparamos el n£mero de registo con el numero solicitado}
  73.                   Begin {si es igual el registro encontrado}
  74.                          Encontrado:=FilePos(AArchivo)-1; {se envia la posicion del registro hallado}
  75.                          Seek(AARchivo,FileSize(AArchivo)); {se envia el puntero al final del archivo para terminar ciclo}
  76.                  End;
  77.          End;
  78.          IF Encontrado <> -1 then {si Encontrado no es igual a -1 , mandamos el valor de la funcion}
  79.              Begin
  80.                      BuscaRegistro:=Encontrado;
  81.              End
  82.          Else {si no fue encontrado regresamos -1 a la busqueda}
  83.              Begin
  84.                      BuscaRegistro:=-1;
  85.              End;
  86.          textattr:=0+2*16;
  87.          gotoxy(4,24);write(' ');
  88. End;
  89.  
  90. {*------|------|------|------|------|------|------|------|------|------|----*}
  91. Procedure BorraRegistro(Var AArchivo:Tipoarchivo; TIRegistro:TipoRegistro;Numero:LongInt);
  92. var
  93.     TmpArchivo:tipoArchivo;
  94.     TmpRegistro:tipoRegistro;
  95.     EncontradoB:longint;
  96. Begin {Buscamos si existe el Registro a borrar}
  97.         EncontradoB:=BuscaRegistro(AArchivo,TIRegistro,Numero);
  98.         IF EncontradoB <> -1 then {Si existe}
  99.            Begin
  100.               seek(AArchivo,0); {nos posicionamos al inicio del archivo}
  101.               While not eof(AArchivo) do {hacemos un ciclo de vaciado de registros a un archivo temporal menos el eliminado}
  102.                     Begin
  103.                         Read(AArchivo,TIRegistro); {leemos el registro completo}
  104.                         IF TIRegistro.Numero <> Numero then {comparamos el campo Registro.numero con el solicitado }
  105.                            Begin
  106.                                AperturaDeArchivoTemporal(TmpArchivo); {creamos el temporal}
  107.                                seek (TmpArchivo,filesize(TmpArchivo)); {nos posicionamos al final del archivo temporal}
  108.                                write(TmpArchivo,TIRegistro); {escribimos el registro}
  109.                                Close(TmpArchivo);{cerramos el registro}
  110.                            End;
  111.                     End;
  112.               Close(AArchivo); {cerramos la bd de trabajo}
  113.               erase(AArchivo); {eliminamos la bd de trabajo}
  114.               { se puede usar en caso de no contar con la utileria sysutils
  115.                    Assign(TmpArchivo,'c:Archivo.Tmp');
  116.                    Rename(TmpArchivo,'c:Archivo.dat'), en el caso de RenameFile }
  117.               If RenameFile ('c:Archivo.tmp','c:Archivo.dat') then
  118.                  begin
  119.                       Gotoxy(3,24);write('Registro Eliminado');
  120.                       Delay(600);
  121.                  End;
  122.            End {encontrado <> -1}
  123.        Else
  124.            Begin
  125.                textattr:=14+4*16;
  126.                gotoxy(27,12);write('No Hallado ......!! ');
  127.                Delay(1000);
  128.                Close(AArchivo); {cerramos la bd de trabajo}
  129.            End;
  130. End;
  131.  
  132.  
  133. {*------|------|------|------|------|------|------|------|------|------|----*}
  134.  
  135. Procedure InicializaRegistro(Var TiRegistro : TipoRegistro);
  136. Begin
  137.        TiRegistro.Numero :=0;
  138.        TiRegistro.Nombre :='';
  139.        TiRegistro.Direccion:='';
  140.        TiRegistro.Telefono :='';
  141. End;
  142.  
  143. {*------|------|------|------|------|------|------|------|------|------|----*}
  144.  
  145. Procedure Alta(TiRegistro:TipoRegistro;Var TiArchivo :TipoArchivo);
  146. Var
  147.     Encontrado:Longint;
  148.     TmpNumero:Longint;
  149.     Salir:char;
  150. Begin
  151.        Repeat
  152.               InicializaRegistro(TiRegistro);
  153.               textattr:=7+0*16;{atributos de pantalla}
  154.               Clrscr;
  155.               Gotoxy(25,4);write('Alta de Registro');
  156.               Gotoxy(25,10);write('Proporcione Numero : ');
  157.               readln(TmpNumero);
  158.  
  159.               AperturaDeArchivo(TIArchivo); {aperturamos el archivo}
  160.               Encontrado:= BuscaRegistro(TiArchivo,TIRegistro,TmpNumero); {buscamos el registro}
  161.               Close(Tiarchivo); {cerramos el archivo}
  162.               If Encontrado = -1 Then {no existe}
  163.                  Begin
  164.                         textattr:=7+0*16;{atributos de pantalla}
  165.                         Tiregistro.Numero:=TmpNumero;
  166.                         Gotoxy(25,12);write('Proporcione Nombre : ');
  167.                         readln(TiRegistro.Nombre );
  168.                         Gotoxy(25,14);write('Proporcione Direccion : ');
  169.                         readln(TiRegistro.Direccion );
  170.                         Gotoxy(25,16);write('Proporcione Tel‚fono : ');
  171.                         readln(TiRegistro.Telefono);
  172.                         {posicionamos el puntero al final del archivo y guardamos}
  173.                          AperturaDeArchivo(TIArchivo);
  174.                          Seek (TIArchivo,filesize(TIArchivo));{posicionamos el puntero al final del archivo}
  175.                          Write(TiArchivo,TiRegistro);{guardamos el registro al final del archivo}
  176.                          Close(TiArchivo);
  177.                          delay(100);
  178.                  End
  179.              else {si existe}
  180.                  begin
  181.                         Gotoxy(15,17);write('Registro Existente,Pulse Enter');
  182.                         readkey;
  183.                  end;
  184.              gotoxy(20,22);write('Desea Continuar Almacenando Registros [S/N]');
  185.              Salir:=Readkey;
  186.        Until (Salir='n') or (Salir='N');
  187. End;
  188.  
  189. {*------|------|------|------|------|------|------|------|------|------|----*}
  190.  
  191. Procedure Baja(TiRegistro:TipoRegistro;Var TiArchivo :TipoArchivo);
  192. Var
  193.    Encontrado:Longint;
  194.    TmpNumero:Longint;
  195.    Salir:char;
  196. Begin
  197.        Repeat
  198.                InicializaRegistro(TiRegistro);
  199.                textattr:=7+0*16;{atributos de pantalla}
  200.                Clrscr;
  201.                Gotoxy(25,4);write('Baja de Registro');
  202.                Gotoxy(25,10);write('Proporcione Numero : ');
  203.                readln(TmpNumero);
  204.                AperturaDeArchivo(TIArchivo); {aperturamos el archivo}
  205.                Encontrado:= BuscaRegistro(TiArchivo,TIRegistro,TmpNumero); {buscamos el registro}
  206.                Close(Tiarchivo); {cerramos el archivo}
  207.                If Encontrado <> -1 Then {existe}
  208.                   Begin
  209.                         AperturaDeArchivo(TIArchivo); {aperturamos el archivo}
  210.                         BorraRegistro(Tiarchivo,TIRegistro,TmpNumero); {llamada al procedimiento de borrado fisico}
  211.                   End
  212.                Else {si no esxiste el registro}
  213.                   Begin
  214.                         Gotoxy(15,17);write('Registro No Existe,Pulse Enter');
  215.                         readkey;
  216.                  End;
  217.                Gotoxy(20,22);Write('Desea Continuar Dando de Baja a Registros [S/N]');
  218.                Salir:=Readkey;
  219.      Until (Salir='n') or (Salir='N');
  220.  
  221. End;
  222.  
  223. {*------|------|------|------|------|------|------|------|------|------|----*}
  224.  
  225. Procedure Modificacion(TiRegistro:TipoRegistro;Var TiArchivo :TipoArchivo);
  226. Var
  227.     Encontrado:Longint;
  228.     Salir:char;
  229. Begin
  230.         Repeat
  231.                 InicializaRegistro(TiRegistro);
  232.                 textattr:=7+0*16;{atributos de pantalla}
  233.                 Clrscr;
  234.                 Gotoxy(25,4);write('Modificacion de Registro');
  235.                 Gotoxy(25,10);write('Proporcione Numero : ');
  236.                 readln(TiRegistro.Numero);
  237.                 AperturaDeArchivo(TIArchivo); {aperturamos el archivo}
  238.                 Encontrado:= BuscaRegistro(TiArchivo,TIRegistro,TiRegistro.Numero); {buscamos el registro}
  239.                 Close(Tiarchivo); {cerramos el archivo}
  240.                 If Encontrado <> -1 Then {existe}
  241.                    Begin
  242.                           textattr:=7+0*16;{atributos de pantalla}
  243.                           Gotoxy(25,12);write('Proporcione Nombre : ');
  244.                           readln(TiRegistro.Nombre );
  245.                           Gotoxy(25,14);write('Proporcione Direccion : ');
  246.                           readln(TiRegistro.Direccion );
  247.                           Gotoxy(25,16);write('Proporcione Tel‚fono : ');
  248.                           readln(TiRegistro.Telefono);
  249.                           AperturaDeArchivo(TIArchivo); {aperturamos el archivo}
  250.                           seek (TIArchivo,Encontrado);{posicionamos el p£ntero en la posici¢n donde se   encontr¢ el registro en el archivo}
  251.                           write(TiArchivo,TiRegistro);{escribimos el registor modificado}
  252.                           close(TiArchivo);
  253.                   End
  254.              Else
  255.                   Begin
  256.                          Gotoxy(15,17);write('Registro No Existe,Pulse Enter');
  257.                          readkey;
  258.                   End;
  259.             Gotoxy(20,22);Write('Desea Continuar Modificando Registros [S/N]');
  260.             Salir:=Readkey;
  261.       Until (Salir='n') or (Salir='N');
  262. End;
  263.  
  264. {*------|------|------|------|------|------|------|------|------|------|----*}
  265.  
  266. Procedure Consulta(TiRegistro:TipoRegistro;Var TiArchivo :TipoArchivo);
  267. Var
  268.     Encontrado:Longint;
  269.     Salir:char;
  270. Begin
  271.        Repeat
  272.                 InicializaRegistro(TiRegistro);
  273.                 textattr:=7+0*16;{atributos de pantalla}
  274.                 Clrscr;
  275.                 Gotoxy(25,4);write('Consulta de Registro');
  276.                 Gotoxy(25,10);write('Proporcione Numero : ');
  277.                 readln(TiRegistro.Numero);
  278.                 AperturaDeArchivo(TIArchivo); {aperturamos el archivo}
  279.                 Encontrado:= BuscaRegistro(TiArchivo,TIRegistro,TiRegistro.Numero); {buscamos el registro}
  280.                 Close(Tiarchivo); {cerramos el archivo}
  281.                 If Encontrado <> -1 Then {existe}
  282.                    Begin
  283.                         textattr:=7+0*16;{atributos de pantalla}
  284.                         Gotoxy(25,12);write('Nombre : ',TiRegistro.Nombre );
  285.                         Gotoxy(25,14);write('Direccion : ',TiRegistro.Direccion );
  286.                         Gotoxy(25,16);write('Tel‚fono : ',TiRegistro.Telefono);
  287.                    End
  288.                 Else {si no existe el registro}
  289.                    Begin
  290.                          Gotoxy(15,17);write('Registro No Existe,Pulse Enter');
  291.                          readkey;
  292.                    End;
  293.                Gotoxy(20,22);Write('Desea Continuar Consultando Registros [S/N]');
  294.                Salir:=Readkey;
  295.      Until (Salir='n') or (Salir='N');
  296. End;
  297.  
  298. {*------|------|------|------|------|------|------|------|------|------|----*}
  299.  
  300. Procedure Listado(TiRegistro:TipoRegistro;var TiArchivo:tipoArchivo);
  301. Var
  302.     Contador:integer;
  303. Begin
  304.        textattr:=7+0*16;{atributos de pantalla}
  305.        Clrscr;
  306.        Gotoxy(2,2);write('Numero Nombre Direccion');
  307.        Seek(TiArchivo,0); {Posicionamos al inicio el puntero del archivo}
  308.        contador:=3;
  309.        While not eof(TiArchivo) do
  310.            Begin
  311.                  Read(TiArchivo,TIRegistro); {Leemos el Registro segun posicion del puntero}
  312.                  gotoxy(2,contador); Write(TIRegistro.Numero);
  313.                  gotoxy(17,contador); Write(TIRegistro.Nombre);
  314.                  gotoxy(47,contador); Write(TIRegistro.Direccion);
  315.                  inc(contador);
  316.           End;
  317.       readkey;
  318. End;
  319.  
  320. {*------|------|------|------|------|------|------|------|------|------|----*}
  321.  
  322. Procedure Menu(TiRegistro:TipoRegistro; Var TiArchivo:TipoArchivo);
  323. Var
  324.     Tecla:Char;
  325. Begin
  326.       ClrScr;
  327.       Repeat
  328.                textattr:=7+0*16;{atributos de pantalla}
  329.                ClrScr;
  330.                Gotoxy(25,6);Write('Alta de Registro ..............[1]');
  331.                Gotoxy(25,8);Write('Modificacion de Registro ......[2]');
  332.                Gotoxy(25,10);Write('Baja de Registro ..............[3]');
  333.                Gotoxy(25,12);Write('Consulta de Registro ..........[4]');
  334.                Gotoxy(25,14);Write('Listado de Registros...........[5]');
  335.                Gotoxy(25,16);Write('Salir .........................[6]');
  336.                Tecla:=Readkey;
  337.                Case Tecla of
  338.                          '1':Begin
  339.                                     Alta(Tiregistro,TiArchivo);
  340.                              End;
  341.                          '2':Begin
  342.                                    Modificacion(TiRegistro,TiArchivo );
  343.                              End;
  344.                          '3':Begin
  345.                                    Baja(TiRegistro,TiArchivo );
  346.                              End;
  347.                         '4':Begin
  348.                                   Consulta(TiRegistro,TiArchivo );
  349.                             End;
  350.                         '5':Begin
  351.                                   AperturaDeArchivo(Tiarchivo);
  352.                                   Listado(TiRegistro,TiArchivo);
  353.                                   Close(TiArchivo);
  354.                             End;
  355.                End;
  356.        Until Tecla = '6';
  357. end;
  358.  
  359. {*------|------|------|------|------|------|------|------|------|------|----*}
  360.  
  361. { Cuerpo del programa }
  362. var
  363.     TiArchivo : TipoArchivo;
  364.     TiRegistro : TipoRegistro;
  365. Begin
  366.      Menu(TiRegistro,TiArchivo);
  367. end.
  368.  
  369.  
  370.  

3
Pascal / Re: Secuencias caracteres
« en: Viernes 27 de Agosto de 2010, 22:07 »
Pues no se ve mucho en tu codigo, mas que llamadas a procedimientos, asi no vemos como estan definidos tus procedimientos y no podemos ayudarte

saludos

4
Pascal / Re: Ordenamiento de Burbuja
« en: Martes 17 de Agosto de 2010, 17:20 »
estoy seguro que aki encontraras el metodo de ordenamiento que buscas


Métodos de Ordenación

h t t p ://driverop.com.ar/pascal.php

5
Pascal / Re: Cursor Invisible?
« en: Martes 3 de Agosto de 2010, 16:44 »
CursorOn; //Activas el cursor
CursorOff; //desactivas el cursor


Al desactivarlo no te olvides de hecharlo andar de nuevo

6
Pascal / aporte , punto de venta
« en: Domingo 18 de Julio de 2010, 06:44 »
En esta ocasión les hago una aportacion de un programita ejemplificando el uso de registros y archivos, entre otras cosas filtros ,ordenamioentos  un poco lentos pero funcionan ,ya uds le haran modificaciones pertinentes .....  ojala que les sea de utilidad.Compilado en FreePascal IDE for dos 0.9.2

algunas pantallas aqui -->h t t p ://pillin-slk.blogspot.com/2010/07/una-demostracion-de-archivos-y.html

7
Pascal / Re: juego de la vida de john Conway
« en: Jueves 15 de Julio de 2010, 19:08 »
en esa pagina esta
yo ya lo he ejecutado alguna vez
 h t t t p://delphidabbler.com/software/life/download

para mas detalles
Source Code (v5.1)
Download link    Description
life_src.zip (91Kb)    
The main Game of Life source code. Contains the source for Life.exe, but does not include source for the help file.
MD5 Checksum: 6d5a30e8dd96f298c2efc3da8bde426f

8
Pascal / Re: juego de la vida de john Conway
« en: Jueves 15 de Julio de 2010, 06:21 »
solo busca en google y lo encuentras
w w w .delphidabbler.com/software/life

9
Pascal / Re: Modo Gráfico.
« en: Sábado 3 de Julio de 2010, 23:35 »
la cosa es que no encuentra la ruta , esaes la razon que no inicia el modo grafico
initGraph(Driver,Modo,'c:progra~1tpbgi');

10
Pascal / Re: Guardar una pila, cola o listas
« en: Viernes 11 de Junio de 2010, 18:52 »
dirias , guardar los datos de la lista o pila

pues a mi se me ocurriria que mientras recorro la lista hasta no encontrar nill , lo almaceno en un archivo...

11
Pascal / Re: Ejercicios sobre punteros, listas, colas y pilas
« en: Martes 8 de Junio de 2010, 22:00 »
en este mismo foro hay ejercicios resueltos

viewtopic.php?f=34&t=40872

12
Pascal / Re: sysutils
« en: Lunes 7 de Junio de 2010, 23:47 »
no veo por que no

13
Pascal / Re: sysutils
« en: Jueves 3 de Junio de 2010, 17:10 »
no tengo idea, deberias preguntarle a driverop, el tiene mas experiencia en estas cosas, creo que sysutils no esta en turbo 7 , deberias buscar algo parecido , que maneje la funcion o precedimiento que requieras,




que funcion buscas realizar?

14
Pascal / Re: sysutils
« en: Miércoles 2 de Junio de 2010, 19:54 »
hola , saludos
por lo regular el sysutils.tpu , viene incluido en tus unidades de pascal, pero verifica que version de pascal estes usando

yo uso freepascal y ahi se encuentra..

15
Pascal / Re: Resolver error en Pascal (cajero automatico)
« en: Jueves 13 de Mayo de 2010, 08:08 »
siguiendo tu código, corrigiendo dos que tres cosas por ahí , respetando tu lógica este es el resultado.. verifica bien  tu lógica si es lo que deseas que arroje en el procedimiento imprime..

 
Código: Pascal
  1.     program cajero;
  2.     uses crt;
  3.  
  4.     var //Globales
  5.     saldo:longint;
  6.     numgi,numdep,op,gi,dep:integer;
  7.  
  8.     (*******************************************************)
  9.     procedure giro(var numdep,numgi:integer ;var saldo:Longint;var gi:integer);
  10.     //realiza giro
  11.    begin
  12.      gi:=0;
  13.      repeat
  14.      write('Ingrese valor a girar = $');
  15.      readln(gi);
  16.      until(gi>0);
  17.      numgi:=numgi+1;
  18.      numdep:=numdep;
  19.      saldo:=saldo-gi;
  20.    end;
  21.    (*******************************************************)
  22.    procedure deposito(var numdep,numgi:integer; var saldo:longint;var dep:integer);
  23.    //realiza deposito
  24.    begin
  25.      dep:=0;
  26.      repeat
  27.      write('Ingrese valor a depositar = $');
  28.      readln(dep);
  29.      until(dep>0);
  30.      numdep:=numdep+1;
  31.      numgi:=numgi;
  32.     saldo:=saldo+dep;
  33.    end;
  34.    (*******************************************************)
  35.    procedure imprime(x,numgi,numdep:Integer;var saldo:Longint);
  36.    //imprime operacion
  37.    var
  38.      b20,b10,b5,b1,m500,m100,m50,m10,m1:integer;
  39.    begin
  40.      b20:=x div 20000;
  41.      x:=x-(20000*b20);
  42.      b10:=x div 10000;
  43.      x:=x-(10000*b10);
  44.      b5:=x div 5000;
  45.      x:=x-(5000*b5);
  46.      b1:=x div 1000;
  47.      x:=x-(1000*b1);
  48.     m500:=x div 500;
  49.      x:=x-(500*m500);
  50.      m100:=x div 100;
  51.      x:=x-(100*m100);
  52.      m50:=x div 50;
  53.      x:=x-(50*m50);
  54.      m10:=x div 10;
  55.      x:=x-(10*m10);
  56.      m1:=x div 1;
  57.      x:=x-(1*m1);
  58.      writeln('| $20000 =',b20:3 ,' |');
  59.      writeln('| $10000 =',b10:3 ,' |');
  60.      writeln('| $5000  =',b5:3  ,' |');
  61.      writeln('| $1000  =',b1:3  ,' |');
  62.      writeln('| $500   =',m500:3,' |');
  63.      writeln('| $100   =',m100:3,' |');
  64.      writeln('| $50    =',m50:3 ,' |');
  65.      writeln('| $10    =',m10:3 ,' |');
  66.      writeln('| $1     =',m1:3  ,' |');
  67.  
  68.     writeln('==============================================================================');
  69.      writeln('Saldo       |Deposito   |Giro       |Num. de Giros  |Num. de Depositos|         ');
  70.      writeln('==============================================================================');
  71.      writeln(saldo:12,dep:12,gi:12,numgi:12,numdep:12);
  72.    end;
  73.    (*******************************************************)
  74.    procedure menu;
  75.    begin
  76.     writeln('=================');
  77.      writeln('Banco PrograBank ');
  78.      writeln('=================');
  79.      writeln;
  80.      writeln('1.- Deposito');
  81.      writeln('2.- Retiro o Giro');
  82.     writeln('3.- Saldo');
  83.     writeln('4.- Salir');
  84.   end;
  85.   (*******************************************************)
  86.   (*******************Principal***************************)
  87.  
  88.   begin
  89.     clrscr;
  90.     saldo:=100000;
  91.     numgi:=0;
  92.     numdep:=0;
  93.     repeat
  94.         menu;
  95.         writeln('Ingrese una opcion');
  96.         read(op);
  97.         If Op In [1..4] then
  98.            Begin
  99.               case (op) of
  100.                  1:begin
  101.                      deposito(numdep,numgi,saldo,dep);
  102.                      imprime(dep,numgi,numdep,saldo);
  103.                    end;
  104.                  2:begin
  105.                      giro(numdep,numgi,saldo,gi);
  106.                      imprime(gi,numgi,numdep,saldo);
  107.                    end;
  108.                  3:begin
  109.                      imprime(0,numgi,numdep,saldo);
  110.                    end;
  111.                  4:begin
  112.                      Writeln('Fin del Programa...');
  113.                      readkey;
  114.                    End;
  115.                  End;{Case}
  116.            End
  117.         Else
  118.            writeln('Ingrese una opcion valida');
  119.     until (op=4);
  120.  end.
  121.  
  122.  

16
Pascal / Re: Resolver error en Pascal (cajero automatico)
« en: Jueves 13 de Mayo de 2010, 07:41 »
creo que en esta parte hay un error de lógica pero no creo que sea tu problema en si

Código: Pascal
  1. # procedure deposito(var numdep,numgi,saldo:integer;dep:integer);
  2. # //realiza deposito
  3. # begin
  4. #   repeat
  5. #   write('Ingrese valor a depositar = $');
  6. #   readln(dep);
  7. #   until(gi>0);
  8.  

mañana checo  tu codigo

17
Pascal / Re: hola necesito q me ayuden a pasarlo a C++
« en: Jueves 13 de Mayo de 2010, 07:33 »
por que no entras a un foro de c?

18
Pascal / Re: no me corre!!
« en: Sábado 17 de Abril de 2010, 05:59 »
coregido, añadiendo lo que DriverOp menciona , no veo problema

Código: Pascal
  1.  
  2. program potencia;
  3. uses crt;
  4. var
  5. B,E,I:integer;
  6. P:real;
  7. Begin
  8.      writeln('introduzca Base');
  9.      readln(b);
  10.      writeln('introduzca Exponente');
  11.      readln(e);
  12.      if (e>=0) then  
  13.         Begin
  14.                P:=1;
  15.                For i:=1 to e do
  16.                     Begin
  17.                           p:=p*b;
  18.                     End;
  19.          End;
  20.      writeln('la potencia positiva es ',p:0:0);
  21.      readkey;
  22. End.
  23.  
  24.  

19
Pascal / Re: validacion captura de datos
« en: Jueves 25 de Febrero de 2010, 03:58 »
mira en esta liga tengo una uileria, tal vez encuentres lo que estas buscando o parte de la solucion que podrias adaptarla a tus necesidades, aun asi esta abierto el codigo
puedes utilizar una funcion llamada EditaLongInt y adaptarla a tus necesidades

viewtopic.php?f=34&t=40724

20
Pascal / Re: Aplicar Random con ciertas restrinciones
« en: Viernes 22 de Enero de 2010, 21:50 »
enhorabuena y exito!.

21
Pascal / Re: Aplicar Random con ciertas restrinciones
« en: Viernes 22 de Enero de 2010, 05:17 »
mi consejo es que mientras vayas creando el random de 1 y ceros recorras la matriz verificando el porcentaje de cada valor y asi puedes balancear tu requerimiento..

saludos

22
Pascal / Re: extraer datos de un archivo txt
« en: Lunes 18 de Enero de 2010, 18:43 »
el arcivo es de texto o con tipo?

23
Pascal / Re: error: no identifica el readkey
« en: Lunes 18 de Enero de 2010, 18:38 »
una pregunta , tienes utilizas la unidad crt


program algo;
uses crt;
begin
end.

24
Pascal / Re: exit code 201: Alguien puede decirme xk falla el programa
« en: Miércoles 6 de Enero de 2010, 23:03 »
te desborda la pila del string, al poner i+1

Código: Pascal
  1.  
  2. for i:=1 to length(frase) do
  3. letra:=frase[i+1];
  4. end;
  5.  

trata de dejarlo solo con este codigo:
Código: Pascal
  1.  
  2. for i:=1 to length(frase) do
  3. letra:=frase[i];
  4. end;
  5.  


aun que este problema ya se resolvio en otro foro

Código: Pascal
  1.  
  2.  
  3. program Fercuencia;
  4. uses crt;
  5.  
  6. var
  7. letra:char;
  8. Frase:string;
  9. Frecuencia : array ['a'..'z'] of longint;
  10. contador:integer;
  11. columna:integer;
  12.  
  13. Begin
  14.  
  15. clrscr;
  16. gotoxy(1,20);write('pulse . para salir...');
  17.  
  18. Repeat
  19. Columna:=1;
  20.  
  21. for contador:=1 to 26 do
  22. begin
  23. gotoxy(1+columna,1);write(chr(96+contador));
  24. gotoxy(1+columna,2);write(Frecuencia[chr(96+contador)]);
  25. inc(columna,3);
  26. end;
  27.  
  28. gotoxy(1,10);write('Proporcione una Frase :');
  29. Letra:=Readkey;
  30.  
  31. If letra in ['a'..'z'] then
  32. Begin
  33. Frecuencia[letra]:= Frecuencia[letra] + 1;
  34. End;
  35. Frase:=Frase+letra;
  36. gotoxy(1,11);write(frase);
  37. Until Letra = '.';
  38.  
  39. End.
  40.  
  41.  
  42.  


h t t p :  / / http://www.lawebdelprogramador.com/news ... &n9=0&n0=0

25
Pascal / Aporte , Calendario
« en: Jueves 10 de Diciembre de 2009, 04:43 »
En Otro foro vi que alguien solicitaba un calendario y la forma convencional de presentarlo en pantalla , por lo que he visto no hay alguno
he aqui mi granito de arena, aceptamos sugerencias y correcciones..espero le sirva a alguien, o cuando menos se de una idea para generar el suyo.

el siguiente es un ejemplo de una funcion que recoje un tecla, la funcion en si, dibuja un calendario desplegando los dias de la semana y la particularidad de manipular lo meses y los años con las flechas, ademas de tomar el dia segun se posicione el cursor.

nota: compilado en freepascal

Código: Pascal
  1.  
  2. Program EjemploCalendario;
  3. Uses crt,sysutils,Calendario;
  4. {cuerpo del programa}
  5. var
  6.   Tecla:char;
  7.   Fecha:String[10];
  8. Begin
  9.    textattr:=14+1*16;
  10.    clrscr;
  11.    Fecha:=FormatDateTime('DD/MM/YYYY',Date);
  12.    Tecla:= FechaAlmanaque(Fecha,10,12,14,4);
  13.    write ('La Fecha es :',fecha);
  14.    readkey;
  15. End.
  16.  
  17.  
  18.  


algunas imagenes :
h t t p:// 4.bp.blogspot.com/_5QIJNhCUCcc/Sx_nNDqOSCI/AAAAAAAAADY/ZjWfeb6V-IU/s1600-h/pantalla+fecha2.JPG
h t t p:// 3.bp.blogspot.com/_5QIJNhCUCcc/Sx_wf_uuskI/AAAAAAAAADw/oUTtOBgG0eY/s1600-h/pantalla+fecha8.JPG
h t t p:// www.pillin-slk.blogspot.com/

Páginas: [1] 2