home *** CD-ROM | disk | FTP | other *** search
/ PC Media 23 / PC MEDIA CD23.iso / share / prog / dclib500 / dclib.int < prev    next >
Encoding:
Text File  |  1994-07-16  |  8.0 KB  |  238 lines
  1. (...)
  2.  
  3. Unit DcLib;
  4.  
  5. (* Febrero,Marzo-1994 *)
  6. (* Librería DcLib Versión 5.00 para Turbo Pascal 7 Modo Real *)
  7. (* ShareWare 1993,94 David Carrero Fernández-Baillo *)
  8. (* 26/03/1994, se corrigen errores en MayMin *)
  9.  
  10. Interface
  11.  
  12. Const
  13.    VersionDcLib = '5.00'; (* Versión de la Librería *)
  14.  
  15. Type
  16.    RangoColor  = 0..63;
  17.  
  18. Function PulsarTecla : Boolean;   { Remplaza a KeyPressed de Unit CRT }
  19.                          {  ;Detecta cuando es pulsada una tecla }
  20.                          {  ;Retorna true si al tecla es pulsada }
  21. Function LeerTecla : Char;
  22. Function EstadoBMay: Boolean;
  23. Function EstadoBNum: Boolean;
  24. Function EstadoBDes: Boolean;
  25. Function EstadoInsertar: Boolean;
  26. Function ActualColorBorde : RangoColor;
  27. Procedure CambiarColorBorde(colorBorde : RangoColor);
  28. Procedure BorrarPanCo(atri : Byte; ch : Char);
  29. procedure ActivarPaginaNB(Pagina : byte);
  30. Function NumLineasPan : Byte;
  31. procedure CursorXY(Columna, Linea : byte);
  32. Procedure PantallaOn;
  33. Procedure PantallaOff;
  34. procedure NoBlink1(OnOff:boolean);
  35. Procedure LCursorPXY (Var Pagina, X, Y: Byte);
  36. Procedure CursorPXY(Pagina, X, Y: Byte);
  37. Function LeerTeclaN: Word;
  38. Function LeerTeclaE: Word;
  39. Function TeclaPulsada : Word;
  40. Procedure CambiarEstadoInsertar(On: Boolean);
  41. Function MododeVideo: Byte;
  42. function PulsarTeclaExt :boolean;
  43. Function MaxX : Byte;
  44. Function MaxY : Byte;
  45. Function DondeX : Byte;
  46. Function DondeY : Byte;
  47. Procedure NewGotoXY(x,y : Byte);
  48. Function HayXY(x,y : Byte) : Char;
  49. Procedure vga50lineas;
  50. Procedure vga43lineas;
  51. Procedure vga25lineas;
  52. Procedure vga30lineas;
  53. Procedure VGAInversa;
  54. procedure BorrarBufferTec;
  55. procedure LineasPantalla( Lines : byte);
  56.  
  57. Procedure Park1;
  58.     (* Aparca la cabezas del disco de un modo *)
  59. Procedure Park2;
  60.     (* Aparca la cabezas del disco de un modo distito al anterior y
  61.        más fiable.*)
  62. Procedure Park3;
  63.     (* Aparca la cabezas del disco de un modo igual al anterior, pero
  64.        devuelve ya texto de finalización de proceso en Castellano *)
  65.  
  66. Procedure Reset_PC0;
  67. Procedure Reset_PC1;
  68. Procedure ResetFrio0;
  69. Procedure ResetFrio1;
  70. procedure Reset_PC2;
  71. Procedure Reset_PC3;
  72.  
  73. Procedure CalibrarRetardo;
  74. Procedure Retardo(Ms : Word);
  75. Procedure Sonido(Freq : Word);
  76. Procedure NoSonido;
  77. Procedure Nota(Freq, Dura : Word);
  78.  
  79. (* Tipos y Variables de la función Num2Let *)
  80. Type
  81.    Str255 = String[255];
  82.    Str10 = String[10];
  83.    Str3 = String[3];
  84.    Str1 = String[1];
  85.    Str80 = String[80];
  86.    Str40 = String[40];
  87.  
  88. (...)
  89.       (* Fin de Tipos y Variables de la función Num2Let *)
  90.  
  91.       (* Variables para funciones Oscurecer y Restaurar *)
  92. (...)
  93.        (* Fin de Variables para funciones Oscurecer y Restaurar *)
  94.  
  95. (...)
  96.  
  97. Function Num2Let(num:Real):Str255;
  98. Procedure OscureceryRestaurarPK(Velocidad:ShortInt);
  99. Procedure Oscurecer1(Velocidad:ShortInt);
  100. Procedure Restaurar1(Velocidad:ShortInt);
  101. Procedure ShellDosMenos;
  102. Procedure DibujarBarrasT( X, Y : Integer; NumeroOpe, Total : LongInt;
  103.                           Width : Integer; Carac : Char);
  104. (* Dibuja barras, ejemplos disponibles en breve
  105.      x, y         : Coordinates where to display the bar
  106.      NumeroOpe    : Número de veces para completar operación
  107.      Total        : Total % a completar
  108.      Width        : Tamaño máximo de la barra *)
  109. Function CopiarFichero( FicheroFuente, FicheroDestino : string) : ShortInt;
  110. (* Códigos que retorna : 0 No hay errores
  111.                          1 Fuente y Destino son los mismos
  112.                          2 No puedo abrir Fuente
  113.                          3 No puedo crear Destino
  114.                          4 error Durante la copia *)
  115. Function TamFichero(Fichero : String) : Longint;
  116. (* retorna -1 si el fichero no es encontrado *)
  117. function ExisteFichero(Fichero:string):boolean;
  118. {retorna true si existe el fichero}
  119. Function ExisteDirectorio( Dir: string ) : boolean;
  120.  
  121. (...)
  122.  
  123. function FicheroUnidad(Todo:string): string;
  124. function FicheroDirectorio(Todo:string): string;
  125. function FicheroNombre(Todo:string): string;
  126. function FicheroExt(Todo:string): string;
  127. function CompletarDirectorio(Dir:string):string;
  128. function NomFicValido(FN:string): shortint;
  129. {Comprueba ruta y nombre de fichero  y retorna:
  130.           -2     Ruta Valida, pero no especificó fichero
  131.           -1     Ruta y nombre bien pero fichero no existe
  132.            0     Ruta y nombre bien y fichero existe
  133.            1     Unidad especificada no es correcta
  134.            2     Caracteres no válidos en ruta
  135.            3     Ruta inválida
  136.            4     Fichero no especificado
  137.            5     Caracteres ilegales en el nombre
  138.            6     Nombre es mayor de 8 caracteres
  139.            7     Extensión es mayor de 3 caracteres }
  140. function BorrarFichero(Filename:string): shortint;
  141. {Retorna:        -1    Fichero no encontrado
  142.                   0    Fichero borrado
  143.                   1    Error - fichero no borrado }
  144. function RenombrarFichero(Oldname,NewName:string):shortint;
  145. {Retorna::     0  Fichero renombrado
  146.                1  Fichero no encontrado
  147.                2  Error - fichero no renombrado }
  148. Procedure SalvaPantallas1;
  149. Procedure PantallaDiv4;
  150.  
  151. Function RepCar(letra:Char; veces:Integer): String;
  152. Function Espacios(num:Integer): String;
  153. Function InverCar(Frase:String):String;
  154. Function MayMin(M : Boolean; Cadena : String): String;
  155.        (* Devuelve una cadena en Mayúsculas o Minúsculas
  156.        TRUE  : Mayúsculas
  157.        FALSE : Minúsculas *)
  158. Function NumEnCad(S: String): Boolean;
  159.        (* Comprueba que en una cadena String exiten solo Números,
  160.                     TRUE  : Solo hay números
  161.                     FALSE : No Solo hay números *)
  162. Procedure InterCadena(Var A, B: String);
  163. Function Left(X: String;  Y: Integer): String;
  164.        (* Función similar a la del BASIC Left$,
  165.           Devuelve una subserie de una serie especificada y de longitud
  166.           indicada en la función, a partir del extremo izquierdo *)
  167.  
  168. Function Right(X: String;  Y: Integer): String;
  169.        (* Función similar a la del BASIC Right$,
  170.           Devuelve una subserie de una serie especificada y de longitud
  171.           indicada en la función, a partir del extremo derecho *)
  172. Function Int2Cad(Numero : longint; Tam : byte) : String;
  173. Function Real2Cad(Numero : real;Tam, Decimales : byte) : String;
  174. {13-3-94}
  175. type
  176.    CadJust = (JIzquierda,JCentrado,JDerecha);
  177.  
  178. Function HexCad (n: Word; count: Byte): String;
  179. Function OctCad (n: Word; count: Byte): String;
  180. Function BinCad (n: Word; count: Byte): String;
  181. Function HexCad1 (w : Word): String;
  182.  
  183. Function FormatoPic(Entra,Pic:string;P:char): string;
  184. Function CadJ(CadJust:CadJust;Cad:string;Tamano:byte;chP:char):string;
  185. Function FormatoCortar(Entra:string;Comienzo,Longitud:byte; P:char):string;
  186. Function EsMay(K:word): boolean;
  187. Function EsMin(K:word): boolean;
  188. Function PrimeraMayPos(Cad : string): byte;
  189. Function PrimeraMay(Cad : string): char;
  190. Function UltimosCar(N:byte;Cad:string):string;
  191. Function PrimerosCar(N:byte;Cad:string):string;
  192. Function PrimerCarMay(Cad:string):string;
  193. Function HexenCad(Str:string):boolean;
  194. Function LongInst2Cad(Numero:longint):string;
  195. Function Longint2HexCad(Numero:longint):string;
  196. Function RealEnCad(Cad:string):boolean;
  197. Function Cad2Real(Cad:string):real;
  198. Function Cad2Int(Str:string):integer;
  199. Function Cad2Longint(Str:string):Longint;
  200. Function HEXCad2Longint(Str:string):longint;
  201.  
  202. Implementation
  203.  
  204. Uses Crt, Dos, CRCLIB;
  205.  
  206. {$I DOS.IMP}
  207.  
  208.  
  209. {$I DcCRT.IMP}
  210. {$I DcPARK.IMP}
  211. {$I DcRESET.IMP}
  212. {$I DcSONI.IMP}
  213. {$I DcUtiles.IMP}
  214. {$I DcString.IMP}
  215.  
  216. {$I DCLIB.COD}
  217.  
  218. var tec : char;
  219.  
  220. begin
  221.   (...)
  222.   begin
  223.     Writeln('Error: CRC Incorrecto.'#7#7);
  224.     Halt;
  225.   end;
  226.   Writeln;
  227.   Writeln('Librería DcLib Versión 5.00.0 para Turbo Pascal 7.xx (TPU)');
  228.   Writeln('Shareware 1993,94 David Carrero Fernández-Baillo');
  229.   Writeln('Versión completa sin registrar');
  230.   Writeln;
  231.   Writeln('Versión No Registrada, completa, no tiene ninguna limitación');
  232.   Writeln('Para eliminar este mensaje, ha que registrarse, consulta la');
  233.   Writeln('documentación y el fichero Registro.500.');
  234.   Writeln;
  235.   Writeln('Pulsa tecla.'#7);
  236.   Tec := ReadKey;
  237. end.
  238. (...) = falta parte el código