Programación General > Pascal
utilerias
(1/1)
epayan:
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 ---program prueba3;uses crt,strings,go32,utileria,sysutils; {unidades o utilerias utilizadas} {-----*-------*-------*-------*--------*------*------*------*-------*------}{ Cuerpo del programa }Var Ventana1 : save_screen; Opcion , Numero : integer; seleccion : ArregloVertical; Tecla : char;Begin textattr:=15+1*16; borraarea(1,1,79,25,15,1); clrscr; {agregamos un menu} Seleccion[1]:='Mant. de Regis'; Seleccion[2]:=' Reportes '; Seleccion[3]:=' Modif. Reg. '; Seleccion[4]:=' Listado '; Seleccion[5]:=' Salir '; cuadro3d(1,1,80,3,2,1); Textattr:=0+2*16; gotoxy(2,2);write('Programa que Ejemplifica el uso de Archivos y Registros en Pascal .11/10/2009'); cuadro3d(2,23,79,25,2,1); Textattr:=0+2*16; gotoxy(45,24);write('Elabor¢: Edwin Ariel Payan Haas'); Repeat cursoroff; opcion := MenuVertical(Seleccion,5,1,5,0,7,15,1); case opcion of 1 : begin GetScreen(ventana1); gotoxy(30,10);write(hola); readln; PutScreen(Ventana1); End; 2 : begin End; 3 : Begin End; 4 : Begin GetScreen(ventana1); gotoxy(30,10);write(hola); readln; PutScreen(Ventana1); End; End;{case} Until (Opcion= 5) or (Opcion = 27); textattr:=15+1*16; borraarea(1,1,79,25,15,1); clrscr; End.
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 ---Function NumAPalabra(Cantidad:real):String;const {Declaramos las unidades del 1 al 29} Unidades: array [1..29] of string[15]= ('UN','DOS','TRES','CUATRO','CINCO','SEIS','SIETE','OCHO','NUEVE','DIEZ', 'ONCE','DOCE','TRECE','CATORCE','QUINCE','DIECISEIS','DIECISIETE','DIECIOCHO','DIECINUEVE','VEINTE', 'VEINTIUN','VEINTIDOS','VEINTITRES','VEINTICUATRO','VEINTICINCO','VEINTISEIS','VEINTISIETE','VEINTIOCHO','VEINTINUEVE'); {declaramos las decenas del 10 al 90} Decenas : array [1..9] of String[15] = ('DIEZ','VEINTE','TREINTA','CUARENTA','CINCUENTA','SESENTA','SETENTA','OCHENTA','NOVENTA'); {Declaramos las centenas del 100 al 900} Centenas :Array [1..9] of string[15] = ('CIENTO','DOSCIENTOS','TRESCIENTOS','CUATROCIENTOS','QUINIENTOS','SEISCIENTOS','SETECIENTOS','OCHOCIENTOS','NOVECIENTOS' ); var {declaramos las variables usadas en la funcion} CantidadReal :Real; CantidadEntera ,TmpCantidadentera :longInt; Centavos :REAL; TextoCentavos :String; TnDigito ,TnPrimerDigito , TnSegundoDigito ,TnTercerDigito :integer; BloqueTexto :String; TnNumeroBloques :Byte; TnBloqueCero :integer; Contador :integer; Begin {Inicializamos las variables} centavos := 0; CantidadEntera := Trunc(Cantidad); TmpCantidadentera:= CantidadEntera; Centavos := round(((CantidadEntera-Cantidad) * 100 )* -1); TnDigito := 0; TnNumeroBloques := 1; TnPrimerDigito := 0; TnSegundoDigito := 0; TnTercerDigito := 0; BloqueTexto := ''; TnBloqueCero := 1; Repeat For Contador:= 1 To 3 do {ciclo para determinar unidades,decenas ,centenas} Begin TnDigito:=TmpCantidadEntera Mod 10;{hacemos el recorrido por cada digito} If TnDigito <> 0 Then{si no es cero buscamos en los arreglos constantes} Begin Case Contador of 1:Begin {si son unidades} BloqueTexto := ' '+ Unidades[TnDigito]; TnPrimerDigito := TnDigito ; End; 2:Begin {si son decenas} If TnDigito <= 2 Then BloqueTexto := ' ' + Unidades[(TnDigito * 10) + TnPrimerDigito ]+ ' ' Else Begin If TnPrimerDigito <> 0 then BloqueTexto := ' '+ Decenas[TnDigito]+ ' Y'+BloqueTexto Else If TnDigito <> 0 then BloqueTexto := ' '+ Decenas[TnDigito] Else BloqueTexto:= BloqueTexto End; TnSegundoDigito := TnDigito; End; 3:Begin {si son centenas} IF (TnDigito = 1) and (TnPrimerDigito = 0) and (TnSegundoDigito = 0) then BloqueTexto:=' CIEN '+BloqueTexto Else BloqueTexto:= Centenas[TnDigito] + BloqueTexto; TnTercerDigito := TnDigito; End; End;{case} TmpCantidadentera:=trunc(TmpCantidadentera/10);{dividimos entre 10 para recorrer la cifra} End Else Begin TnBloqueCero := TnBloqueCero + 1 ;{validamos los bloques para determinar miles y millones} TmpCantidadentera:=trunc(TmpCantidadentera/10);{dividimos entre 10 para recorrer la cifra} If TmpCantidadEntera = 0 Then {rompiendo el ciclo forzozamente} Contador:=3; End; End;{for} Case TnNumeroBloques of {validando miles y millones} 1: Begin {validando cientos} NumAPalabra := BloqueTexto; End; 2 :Begin {validando miles} If TnBloqueCero < 2 then NumAPalabra:=BloqueTexto+NumAPalabra Else begin If (TnPrimerDigito = 0) and (TnSegundoDigito = 0) and (TnTercerDigito = 0) then NumAPalabra:=BloqueTexto+NumAPalabra Else NumAPalabra:=BloqueTexto+' MIL '+NumAPalabra; End; End; 3 :Begin {validando millones} If (TnPrimerDigito = 1) and (TnSegundoDigito = 0) and (TnTercerDigito = 0) then NumAPalabra:= BloqueTexto + ' MILLON '+ NumAPalabra Else NumAPalabra:= BloqueTexto + ' MILLONES '+ NumAPalabra; End; End;{case} TnNumeroBloques := TnNumeroBloques + 1 ; {incrementando el bloque} {inicializando variables para las siguientes pasadas en caso de haber miles y millones} TnDigito := 0; TnPrimerDigito := 0; TnSegundoDigito := 0; TnTercerDigito := 0; BloqueTexto := ''; Until TmpCantidadEntera = 0 ;{validar hasta que que sea 0} Str(Centavos:2:0,TextoCentavos);{convirtiendo los centavos a texto} If CantidadEntera > 1 then {si la cantidad es mayor que 1} NumAPalabra:= 'SON: ('+ NumAPalabra +' PESOS '+TextoCentavos+'/100 M.N)' Else {en caso que sea 1} NumAPalabra:= 'SON: ('+ NumAPalabra +' PESO '+TextoCentavos+'/100 M.N)'End; cualquier aportacion para enriquecer a la utileria sera bienvenida
compartamos codigo solo asi se superan las personas......
m0skit0:
Gracias por compartir :good:
epayan:
anexo mas funciones a la utileria
Navegación
Ir a la versión completa