• Domingo 22 de Diciembre de 2024, 12:31
« anterior próximo »
Páginas: [1]

Autor Tema:  utilerias  (Leído 1960 veces)

epayan

  • Miembro activo
  • **
  • Mensajes: 41
  • Nacionalidad: mx
    • Ver Perfil
    • http://www.pillin-slk.blogspot.com
utilerias
« en: Jueves 17 de Septiembre de 2009, 22:49 »
0
hola foro, revisando el baul me tope con algunas utilerias usadas que me gustaria reciclar y compartir , para los programas inline, ya un poco viejitos recondicionados para freepascal..
un saludo y espero que les sea util..
los procedimientos y funciones que se incluyen:
1.- GetScreen .
2.- PutScreen.
3.- Marco.
4.- cuadro.
5.- cuadro3d.
6.-PresentaTextoDerecha.
7.-PresentaTextoIzquierda.
8.-PresentaTextoMedio.
9.-MenuVertical.
10.- MenuHorizontal.
11.- Concatena.
12.-RellenaBlancos.
13.-RellenaCaracter.
14.-Borraarea
15.-ConvierteMayuscula.
16.-EditaCuerda.
17.-EditaFecha.
18.-EditaPassword
19.-EditaEntero.
20.-EditaByte.
21.-EditaLongint.
22.-EditaReal.
23.-NumAPalabra

aquie un ejemplo:
Código: Pascal
  1. program prueba3;
  2. uses crt,strings,go32,utileria,sysutils; {unidades o utilerias utilizadas}
  3.  
  4. {-----*-------*-------*-------*--------*------*------*------*-------*------}
  5. { Cuerpo del programa }
  6. Var
  7.     Ventana1 : save_screen;
  8.     Opcion   , Numero : integer;
  9.     seleccion : ArregloVertical;
  10.     Tecla : char;
  11. Begin
  12.     textattr:=15+1*16;
  13.     borraarea(1,1,79,25,15,1);
  14.     clrscr;
  15.     {agregamos un menu}
  16.     Seleccion[1]:='Mant. de Regis';
  17.     Seleccion[2]:='  Reportes    ';
  18.     Seleccion[3]:=' Modif. Reg.  ';
  19.     Seleccion[4]:=' Listado      ';
  20.     Seleccion[5]:=' Salir        ';
  21.     cuadro3d(1,1,80,3,2,1);
  22.     Textattr:=0+2*16;
  23.     gotoxy(2,2);write('Programa que Ejemplifica el uso de Archivos y Registros en Pascal .11/10/2009');
  24.     cuadro3d(2,23,79,25,2,1);
  25.     Textattr:=0+2*16;
  26.     gotoxy(45,24);write('Elabor¢: Edwin Ariel Payan Haas');
  27.  
  28.     Repeat
  29.        cursoroff;
  30.        opcion := MenuVertical(Seleccion,5,1,5,0,7,15,1);
  31.        case opcion of
  32.             1 : begin
  33.                    GetScreen(ventana1);
  34.                    gotoxy(30,10);write(hola);
  35.                    readln;
  36.                    PutScreen(Ventana1);
  37.                 End;
  38.             2 : begin
  39.                 End;
  40.             3 : Begin
  41.                 End;
  42.             4 : Begin
  43.                    GetScreen(ventana1);
  44.                    gotoxy(30,10);write(hola);
  45.                    readln;
  46.                    PutScreen(Ventana1);
  47.                 End;
  48.        End;{case}
  49.     Until (Opcion= 5) or (Opcion = 27);
  50.     textattr:=15+1*16;
  51.     borraarea(1,1,79,25,15,1);
  52.     clrscr;
  53.  
  54. End.
  55.  
  56.  


un ejemplo visual de este codigo:
http: // 2.bp.blogspot.com/_5QIJNhCUCcc/SrP6imfuOoI/AAAAAAAAABg/HTFASS_gZv8/s1600-h/pantalla+demo.JPG


Agregando mas codigo a la utileria incluyo una funcion convierte numero a palabras , el codigo estaba en Visual Basic y se porto a pascal. cito las fuentes , por que hay que dar credito a los autores http:/ / gchable.wordpress.com/2007/10/14/4/ , al parecer el autor es Saúl López con una pequeña modificación de ByPaco² .
el codigo anexado a continuacion:

Código: Pascal
  1. Function NumAPalabra(Cantidad:real):String;
  2. const
  3.    {Declaramos las unidades del 1 al 29}
  4.    Unidades: array [1..29] of string[15]= ('UN','DOS','TRES','CUATRO','CINCO','SEIS','SIETE','OCHO','NUEVE','DIEZ',
  5.                                              'ONCE','DOCE','TRECE','CATORCE','QUINCE','DIECISEIS','DIECISIETE','DIECIOCHO','DIECINUEVE','VEINTE',
  6.                                              'VEINTIUN','VEINTIDOS','VEINTITRES','VEINTICUATRO','VEINTICINCO','VEINTISEIS','VEINTISIETE','VEINTIOCHO','VEINTINUEVE');
  7.    {declaramos las decenas del 10 al 90}
  8.    Decenas : array [1..9] of String[15] = ('DIEZ','VEINTE','TREINTA','CUARENTA','CINCUENTA','SESENTA','SETENTA','OCHENTA','NOVENTA');
  9.  
  10.    {Declaramos las centenas del 100 al 900}
  11.    Centenas :Array [1..9] of string[15] = ('CIENTO','DOSCIENTOS','TRESCIENTOS','CUATROCIENTOS','QUINIENTOS','SEISCIENTOS','SETECIENTOS','OCHOCIENTOS','NOVECIENTOS' );
  12.  
  13. var {declaramos las variables usadas en la funcion}
  14.    CantidadReal    :Real;
  15.    CantidadEntera  ,TmpCantidadentera :longInt;
  16.    Centavos        :REAL;
  17.    TextoCentavos   :String;
  18.    TnDigito        ,TnPrimerDigito ,
  19.    TnSegundoDigito ,TnTercerDigito :integer;
  20.    BloqueTexto     :String;
  21.    TnNumeroBloques :Byte;
  22.    TnBloqueCero    :integer;
  23.    Contador        :integer;
  24.  
  25. Begin
  26.    {Inicializamos las variables}
  27.    centavos         := 0;
  28.    CantidadEntera   := Trunc(Cantidad);
  29.    TmpCantidadentera:= CantidadEntera;
  30.    Centavos         := round(((CantidadEntera-Cantidad) * 100 )* -1);
  31.    TnDigito         := 0;
  32.    TnNumeroBloques  := 1;
  33.    TnPrimerDigito   := 0;
  34.    TnSegundoDigito  := 0;
  35.    TnTercerDigito   := 0;
  36.    BloqueTexto      := '';
  37.    TnBloqueCero     := 1;
  38.  
  39.    Repeat
  40.         For Contador:= 1 To 3  do {ciclo para determinar unidades,decenas ,centenas}
  41.             Begin
  42.               TnDigito:=TmpCantidadEntera Mod 10;{hacemos el recorrido por cada digito}
  43.               If TnDigito <> 0 Then{si no es cero buscamos en los arreglos constantes}
  44.                  Begin
  45.                       Case Contador of
  46.                           1:Begin  {si son unidades}
  47.                                 BloqueTexto := ' '+ Unidades[TnDigito];
  48.                                 TnPrimerDigito := TnDigito ;
  49.                             End;
  50.                           2:Begin {si son decenas}
  51.                                 If TnDigito <= 2 Then
  52.                                    BloqueTexto := ' ' + Unidades[(TnDigito * 10) + TnPrimerDigito ]+ ' '
  53.                                 Else
  54.                                    Begin
  55.                                        If TnPrimerDigito <> 0 then
  56.                                            BloqueTexto := ' '+ Decenas[TnDigito]+ ' Y'+BloqueTexto
  57.                                        Else
  58.                                           If TnDigito <> 0 then
  59.                                              BloqueTexto := ' '+ Decenas[TnDigito]
  60.                                           Else
  61.                                              BloqueTexto:= BloqueTexto
  62.                                        End;
  63.                                    TnSegundoDigito := TnDigito;
  64.                                    End;
  65.                            3:Begin {si son centenas}
  66.                                  IF (TnDigito = 1) and (TnPrimerDigito = 0) and (TnSegundoDigito = 0) then
  67.                                      BloqueTexto:=' CIEN '+BloqueTexto
  68.                                  Else
  69.                                     BloqueTexto:= Centenas[TnDigito] + BloqueTexto;
  70.                                  TnTercerDigito := TnDigito;
  71.                              End;
  72.                       End;{case}
  73.                    TmpCantidadentera:=trunc(TmpCantidadentera/10);{dividimos entre 10 para recorrer la cifra}
  74.                  End
  75.               Else
  76.                  Begin
  77.                      TnBloqueCero := TnBloqueCero + 1 ;{validamos los bloques para determinar miles y millones}
  78.                      TmpCantidadentera:=trunc(TmpCantidadentera/10);{dividimos entre 10 para recorrer la cifra}
  79.                      If TmpCantidadEntera = 0 Then {rompiendo el ciclo forzozamente}
  80.                         Contador:=3;
  81.                  End;
  82.          End;{for}
  83.          Case TnNumeroBloques of {validando miles y millones}
  84.               1: Begin {validando cientos}
  85.                      NumAPalabra := BloqueTexto;
  86.                  End;
  87.              2 :Begin {validando miles}
  88.                     If TnBloqueCero < 2 then
  89.                        NumAPalabra:=BloqueTexto+NumAPalabra
  90.                     Else
  91.                        begin
  92.                           If (TnPrimerDigito = 0) and (TnSegundoDigito = 0) and (TnTercerDigito = 0) then
  93.                              NumAPalabra:=BloqueTexto+NumAPalabra
  94.                           Else
  95.                              NumAPalabra:=BloqueTexto+' MIL '+NumAPalabra;
  96.                        End;
  97.                  End;
  98.               3 :Begin {validando millones}
  99.                      If (TnPrimerDigito = 1) and (TnSegundoDigito = 0) and (TnTercerDigito = 0) then
  100.                         NumAPalabra:= BloqueTexto + ' MILLON '+ NumAPalabra
  101.                      Else
  102.                         NumAPalabra:= BloqueTexto + ' MILLONES '+ NumAPalabra;
  103.                  End;
  104.             End;{case}
  105.             TnNumeroBloques := TnNumeroBloques + 1 ; {incrementando el bloque}
  106.            {inicializando variables para las siguientes pasadas en caso de haber miles y millones}
  107.             TnDigito        := 0;
  108.             TnPrimerDigito  := 0;
  109.             TnSegundoDigito := 0;
  110.             TnTercerDigito  := 0;
  111.             BloqueTexto     := '';
  112.      Until TmpCantidadEntera = 0 ;{validar hasta que que sea 0}
  113.      Str(Centavos:2:0,TextoCentavos);{convirtiendo los centavos a texto}
  114.      If CantidadEntera > 1 then {si la cantidad es mayor que 1}
  115.         NumAPalabra:= 'SON: ('+ NumAPalabra  +' PESOS '+TextoCentavos+'/100 M.N)'
  116.      Else {en caso que sea 1}
  117.         NumAPalabra:= 'SON: ('+ NumAPalabra  +' PESO '+TextoCentavos+'/100 M.N)'
  118. End;
  119.  
cualquier aportacion para enriquecer a la utileria sera bienvenida

compartamos codigo solo asi se superan las personas......
El mensaje contiene 1 archivo adjunto. Debes ingresar o registrarte para poder verlo y descargarlo.
« última modificación: Domingo 4 de Julio de 2010, 18:04 por epayan »

m0skit0

  • Miembro de PLATA
  • *****
  • Mensajes: 2337
  • Nacionalidad: ma
    • Ver Perfil
    • http://fr33kk0mpu73r.blogspot.com/
Re: utilerias
« Respuesta #1 en: Viernes 18 de Septiembre de 2009, 13:44 »
0
Gracias por compartir :good:

epayan

  • Miembro activo
  • **
  • Mensajes: 41
  • Nacionalidad: mx
    • Ver Perfil
    • http://www.pillin-slk.blogspot.com
Re: utilerias
« Respuesta #2 en: Miércoles 23 de Septiembre de 2009, 02:10 »
0
anexo mas funciones a la utileria
Páginas: [1]
« anterior próximo »