home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / utility / utility.doc next >
Encoding:
Text File  |  1994-04-11  |  72.0 KB  |  1,409 lines
  1. {
  2.  
  3.  
  4.  
  5.  
  6.  
  7.  
  8.  
  9.  
  10.  
  11.  
  12.  
  13.  
  14.  
  15.  
  16.  
  17.  
  18.  
  19.  
  20.  
  21.  
  22.  
  23.                                  Utility 16.1
  24.  
  25.                    Copyright (C) 1990, 1991 by Gemini Systems
  26.  
  27.  
  28.  
  29.  
  30.  
  31.  
  32.  
  33.  
  34.  
  35.  
  36.  
  37.  
  38.  
  39.  
  40.  
  41.  
  42.  
  43.  
  44.  
  45.  
  46.  
  47.  
  48.  
  49.  
  50.  
  51.  
  52.  
  53.  
  54.  
  55.  
  56.  
  57.  
  58.  
  59. Utility 16.1  (c) Copyright 1990, 1991 by Gemini Systems   ALL RIGHTS RESERVED
  60.  
  61.  
  62. ╒════════════════════════════════════════════════════════════════════════╕
  63. │          This UNIT was written for TURBO PASCAL 6.0 by:                │
  64. │                                                                        │
  65. │                      GEMINI SYSTEMS                                    │
  66. │                      7748 Lake Ridge Drive                             │
  67. │                      Union Lake, MI 48387                              │
  68. │                                                                        │
  69. │                      BBS Support (313) 360-4931                        │
  70. │                      FAX Support (313) 360-6407                        │
  71. │                                                                        │
  72. │             Comments, Suggestions or Donations welcome.                │
  73. │                                                                        │
  74. │  To use in your programs, simply state UTILITY in your uses clause and │
  75. │  compile your program with the $V- compiler directive.                 │
  76. │                                                                        │
  77. │  example:      PROGRAM prog_name;                                      │
  78. │                  USES utility;                                         │
  79. ├────────────────────────────────────────────────────────────────────────┤
  80. │ Modification History:                                                  │
  81. │                                                                        │
  82. │      Version Number    Date             Change Made                    │
  83. │  ───────────────────────────────────────────────────────────────────── │
  84. │         11.5         09-11-90         Add SAVE_LINE & REBUILD_LINE     │
  85. │         11.6         09-17-90         Modify DAYWEEK procedure         │
  86. │         11.7         10-04-90         Add Program Name to SHOW_VERSION │
  87. │         11.8         10-13-90         Minor change to READ_REAL        │
  88. │         11.9         10-18-90         Eliminate char 0 in PAD          │
  89. │         12.0         11-21-90         Added FILL_SCREEN, REBOOT and    │
  90. │                                       PROGRAM_LOCATION                 │
  91. │         13.1         12-03-90         Conversion to TP v6.0            │
  92. │                                       Added BLINK_ON, BLINK_OFF,       │
  93. │                                       and VGA_INSTALLED, SCREEN_ON &   │
  94. │                                       SCREEN_OFF                       │
  95. │         13.2         12-06-90         Changed SHADOW on POP_WINDOW     │
  96. │         13.3         12-17-90         Added POP_MESSAGE &              │
  97. │                                       POP_WINDOW_TITLE, RESTORE_CURSOR │
  98. │                                       & TEXTATTR_AT_ENTRY              │
  99. │         13.4         12-22-90         Activate PRINT_SCREEN Procedure  │
  100. │         13.5         02-15-91         Added _WORD function             │
  101. │         14.1         03-30-91         Added READ_STR, SHIFTS_KEYS,     │
  102. │                                       GLOBAL.                          │
  103. │         14.2                          READ_R, READ_I, READ_L           │
  104. │         14.3         04-06-91         ALT, CNTL added to READCHTIME    │
  105. │         14.4         04-09-91         ADDED READ_MONEY AND READ_DIGIT  │
  106. │         14.5         04-10-91         Modified READ_MONEY to allow     │
  107. │                                       number of decimal places.        │
  108. │         14.6         04-14-91         Speed improvements to READ_MONEY │
  109. │         14.7         05-10-91         EventHandler, and BLANKS added.  │
  110. │         14.8         05-18-91         Added Control-Alpha Keys         │
  111. │         14.9         05-19-91         Revised default exit-chars       │
  112. │         15.0         05-28-91         Bug in READ_STR RIGHT & LEFT     │
  113. │         15.1         06-06-91         Bug in PRINTER_READY             │
  114. │         15.2         08-04-91         SetBlink (works with CGA)        │
  115. │         15.3         08-16-91         FW Does not scroll at 80,25      │
  116. │         15.4         10-11-91         Add PackKey & UnPackKey          │
  117. │         15.5         10-18-91         Minor bug in WRITE_DATE          │
  118. │         15.6         10-23-91         Added X_IN & X_OUT               │
  119. │         15.7         10-28-91         Minor speed improvements         │
  120. │         15.8         10-30-91         Add COMMAND_BUFFER               │
  121. │         15.9         11-11-91         Speed up FW                      │
  122. │         16.0         11-21-91         Bug in READCH, GOTOXY POP_MESSAGE│
  123. │         16.1         12-09-91         Add StuffBuffer                  │
  124. ╘════════════════════════════════════════════════════════════════════════╛
  125. }
  126.  
  127. UNIT UTILITY;
  128. INTERFACE
  129.   USES CRT, DOS, PRINTER;
  130.  
  131. CONST
  132.  
  133.   GEMINI_SYSTEMS : STRING[14] = ' ';
  134.  
  135.   COMMAND_BUFFER : STRING = '';            { If this is <> '' then whenever
  136.                                              you call any of the UTILITY
  137.                                              read procedures, the first
  138.                                              character of this string will
  139.                                              be returned instead of keyboard
  140.                                              input.                           }
  141.  
  142.   VERSION : STRING[15] = 'UTILITY 16.1';   { Reset in Application if Desired   }
  143.                                            { Example:    VERSION := 'V1.0';    }
  144.   RESET_CURSOR : BOOLEAN = TRUE;           { Cursor will be reset to normal    }
  145.                                            { at exit of program if left TRUE   }
  146.  
  147.   ENTER_KEY  : STRING[3] = CHR(17)+CHR(196)+CHR(217);
  148.                           { The Symbol for Enter Key }
  149.  
  150.   HELP_ATTR  : BYTE = $4F;  { Color used to display help line below         }
  151.   HELP_LINE  : STRING[79] = '  Alt-F10 for Version Number';
  152.                           { If user presses Alt key this line is displayed  }
  153.                           { Set this to '' to de-activate this option       }
  154.  
  155.   HELP_ATTR2 : BYTE = $4F;  { Color used to display help line below         }
  156.   HELP_LINE2 : STRING[79] = '  No Control Keys defined';
  157.                           { If user presses CtrL key this line is displayed }
  158.                           { Set this to '' to de-activate this option       }
  159.  
  160.   EventHandler : POINTER = NIL;   { Set this pointer to the address of any
  161.                                     procedure and that procedure will be
  162.                                     called after every keypress handled
  163.                                     by any of the read commands in this
  164.                                     utility.  THIS PROCEDURE MUST BE
  165.                                     COMPILED WITH THE $F+ DIRECTIVE.   }
  166.  
  167.   FUNC1    = #127;
  168.   FUNC2    = #128;
  169.   FUNC3    = #129;
  170.   FUNC4    = #130;
  171.   FUNC5    = #131;
  172.   FUNC6    = #132;
  173.   FUNC7    = #133;
  174.   FUNC8    = #134;
  175.   FUNC9    = #135;
  176.   FUNC10   = #136;
  177.   FUNC11   = #137;
  178.   FUNC12   = #138;
  179.   AF1      = #139;   { ALT-F1 }
  180.   AF2      = #140;
  181.   AF3      = #141;
  182.   AF4      = #142;
  183.   AF5      = #143;
  184.   AF6      = #144;
  185.   AF7      = #145;
  186.   AF8      = #146;
  187.   AF9      = #147;
  188.   AF10     = #148;
  189.   AF11     = #149;  { Future Use Only }
  190.   AF12     = #150;  { Future Use Only }
  191.   ALT_A    = #151;
  192.   ALT_B    = #152;
  193.   ALT_C    = #153;
  194.   ALT_D    = #154;
  195.   ALT_E    = #155;
  196.   ALT_F    = #156;
  197.   ALT_G    = #157;
  198.   ALT_H    = #158;
  199.   ALT_I    = #159;
  200.   ALT_J    = #160;
  201.   ALT_K    = #161;
  202.   ALT_L    = #162;
  203.   ALT_M    = #163;
  204.   ALT_N    = #164;
  205.   ALT_O    = #165;
  206.   ALT_P    = #166;
  207.   ALT_Q    = #167;
  208.   ALT_R    = #168;
  209.   ALT_S    = #169;
  210.   ALT_T    = #170;
  211.   ALT_U    = #171;
  212.   ALT_V    = #172;
  213.   ALT_W    = #173;
  214.   ALT_X    = #174;
  215.   ALT_Y    = #175;
  216.   ALT_Z    = #176;
  217.   CF1      = #200;   { CONTROL-F1 }
  218.   CF2      = #201;
  219.   CF3      = #202;
  220.   CF4      = #203;
  221.   CF5      = #204;
  222.   CF6      = #205;
  223.   CF7      = #206;
  224.   CF8      = #207;
  225.   CF9      = #208;
  226.   CF10     = #209;
  227.   CF11     = #210;   { Future Use Only }
  228.   CF12     = #211;   { Future Use Only }
  229.   C_A      = #1;     { CONTROL-A }
  230.   C_B      = #2;
  231.   C_C      = #3;
  232.   C_D      = #4;
  233.   C_E      = #5;
  234.   C_F      = #6;
  235.   C_G      = #7;
  236.   C_H      = #8;
  237.   C_I      = #9;
  238.   C_J      = #10;
  239.   C_K      = #11;
  240.   C_L      = #12;
  241.   C_M      = #13;
  242.   C_N      = #14;
  243.   C_O      = #15;
  244.   C_P      = #16;
  245.   C_Q      = #17;
  246.   C_R      = #18;
  247.   C_S      = #19;
  248.   C_T      = #20;
  249.   C_U      = #21;
  250.   C_V      = #22;
  251.   C_W      = #23;
  252.   C_X      = #24;
  253.   C_Y      = #25;
  254.   C_Z      = #26;
  255.   PGUP     = #178;
  256.   PGDN     = #179;
  257.   UP       = #180;
  258.   DOWN     = #181;
  259.   LEFT     = #191;
  260.   RIGHT    = #192;
  261.   BACKUP   = #194;
  262.   HOMEKEY  = #196;
  263.   ENDKEY   = #197;
  264.   INSKEY   = #198;
  265.   DELKEY   = #199;
  266.   BACKSPACE= #8;
  267.   TAB      = #9;
  268.   ENTER    = #13;
  269.   RETURN   = #13;
  270.   ESCAPE   = #27;
  271.  
  272. TYPE
  273.   STR2     = STRING [2];
  274.   STR3     = STRING [3];
  275.   STR8     = STRING [8];
  276.   STR16    = STRING [16];
  277.   STR20    = STRING [20];
  278.   STR80    = STRING [80];
  279.   BUFFER   = ARRAY [1..4000] OF CHAR;  { Use for calls to SAVE_SCREEN      }
  280.   BUF160   = ARRAY [1..160]  OF BYTE;  { Use for calls to SAVE_LINE        }
  281.   LINE_SET = SET OF 1..80;             { Use for calls to SET_ATTR         }
  282.   CURTYPE  = (BLOCK,                   { Use for calls to SET_CURSOR       }
  283.               UNDERLINE,
  284.               NONE,
  285.               HALF);
  286.   ETYPE    = SET OF CHAR;
  287.   CTYPE    = SET OF 1..80;
  288.   TYPEN    = (RNUM,LNUM,INUM);
  289.   UT_TYPE  = RECORD
  290.                TIMEX         : INTEGER;
  291.                TIMEY         : INTEGER;
  292.                TIME_TYPE     : CHAR;
  293.                DATEX         : INTEGER;
  294.                DATEY         : INTEGER;
  295.                DATE_TYPE     : CHAR;
  296.                INPUT_ATTR    : BYTE;
  297.                DEFAULT_ATTR  : BYTE;
  298.                COMPILED_DATE : STR8;
  299.                COMPILED_TIME : STRING[5];
  300.                NOCONV        : BOOLEAN;
  301.                EXITCH        : ARRAY [1..255] OF BOOLEAN;
  302.              END;
  303.  
  304. VAR
  305.   CH         : CHAR;                { Global CHAR Variable              }
  306.   NOCONV     : CHAR;                { If included in EXITCH to READSTR  }
  307.                                     { LEFT or RIGHT is not converted to }
  308.                                     { UP or DOWN if in first or last
  309.                                     { position.                         }
  310.   CLEAR      : CHAR;                { If included in EXITCH to READSTR  }
  311.                                     { the value being edited is set to  }
  312.                                     { spaces.                           }
  313.   CGA_PRESENT: BOOLEAN;             { Is TRUE if CGA-ABILITY is Present }
  314.   EGA_PRESENT: BOOLEAN;             { Is TRUE if EGA-ABILITY is Present }
  315.   VGA_PRESENT: BOOLEAN;             { Is TRUE if VGA-ABILITY is Present }
  316.   SHOW_ERROR : BOOLEAN;             { If set to FALSE in Application,   }
  317.                                     { Error Handler is De-Activated.    }
  318.  
  319.   DOS_VER    : STRING [4];          { Contains DOS Version at Startup   }
  320.                                     { i.e.  "3.31"                      }
  321.  
  322.   TIME       : STR8;                { Is set to Current Time at Startup }
  323.   DATE       : STRING[30];          { Is set to Current Date at Startup }
  324.                                     { Date & Time are updated when any  }
  325.                                     { of the following routines are     }
  326.                                     { called:                           }
  327.                                     {     READSTR     Updates Time      }
  328.                                     {     READSTR_BIG Updates Time      }
  329.                                     {     READ_REAL   Updates Time      }
  330.                                     {     READ_INT    Updates Time      }
  331.                                     {     READCHTIME  Updates Time      }
  332.                                     {     WRITE_TIME  Updates Time      }
  333.                                     {     READCHT     Updates Time      }
  334.                                     {     WRITE_DATE  Updates Date      }
  335.   TIM        : LONGINT;             { Is used with START_TIMER at Entry }
  336.                                     { or can be used by application.    }
  337.  
  338.   P          : ^BUFFER;             { Pointer to Video Memory           }
  339.   CUR        : CURTYPE;             { Stores the Current Cursor Shape   }
  340.   DISPLAY    : CHAR;
  341.   NUM_INPUTS : INTEGER;
  342.  
  343.   CHANGED    : BOOLEAN;             { Set to TRUE or FALSE after each     }
  344.                                     { call to:
  345.                                               READSTR
  346.                                               READ_REAL
  347.                                               READ_INT
  348.                                       depending if that value has changed.}
  349.   DOW        : WORD;                { Contains Day-of-Week after a call to
  350.                                       WRITE_DATE                          }
  351.   DYNAMIC_PATHEXEC : BOOLEAN;       { For future use only                 }
  352.   NOW        : INTEGER;             { After each all to WRITE_TIME this
  353.                                       integer contains the number of minutes
  354.                                       since 12:00 midnight                  }
  355.   TEXTATTR_AT_ENTRY  : BYTE;        { Set to TEXTATTR at entry to program   }
  356.                                     { at exit of program the default colors }
  357.                                     { are reset to whatever this value is   }
  358.   UT                 : UT_TYPE;     { Global variables                      }
  359.  
  360.   X_IN               : INTEGER;     { Cursor position on entry to READ_STR  }
  361.   X_OUT              : INTEGER;     { Cursor position on exit from READ_STR }
  362.  
  363.   GLOBAL             : STRING[15] ABSOLUTE $0000:$04F0;
  364.                                     { This variable acces 16 bytes of memory }
  365.                                     { that are reserved for programmer use.  }
  366.                                     { This location allows one program to    }
  367.                                     { to communicate with another.           }
  368.                                     { If you set this value in one program   }
  369.                                     { you can later read it in any other     }
  370.                                     { and the original value will be there.  }
  371.  
  372. (*════════════════════════════════════════════════════════════════════════*)
  373. PROCEDURE BEEP;
  374.  
  375. (*                                    Nicer than CHR(7).                  *)
  376. (*════════════════════════════════════════════════════════════════════════*)
  377. PROCEDURE BIN_LED(L : BYTE);
  378.  
  379. {   USES KEYBOARD LED'S TO TURN ON A BINARY NUMBER FROM 0 TO 7            }
  380. {                                                                         }
  381. {   BIN_LED(5)                        Used for Debugging,                 }
  382. {                                     0 Turns OFF CAPS, SCROLL, NUM       }
  383. {                                     1 Turns ON SCROLL, OFF CAPS, NUM    }
  384. {                                     2 Turns ON NUM, OFF CAPS, SCROLL    }
  385. {     BINARY VALUE                    3 Turns ON SCROLL, NUM OFF CAPS     }
  386. {  CAPS   NUM   SCROLL                4 Turns ON CAPS, OFF SCROLL, NUM    }
  387. {                                     5 Turns ON CAPS, SCROLL, OFF NUM    }
  388. {    4     2       1                  6 Turns ON CAPS, NUM, OFF SCROLL    }
  389. {                                     7 Turns ON CAPS, NUM, SCROLL        }
  390. (*════════════════════════════════════════════════════════════════════════*)
  391. FUNCTION BLANKS(INSTRING : STRING) : BOOLEAN;
  392.  
  393. {   S : STRING;                       Returns true of the string passed   }
  394. {                                     is blanks.  The Length byte is used }
  395. {   S := '    ';                      and only that many characters are.  }
  396. {   IF S = BLANKS THEN                checked.                            }
  397. {     PROCESS_ROUTINE;                                                    }
  398. (*════════════════════════════════════════════════════════════════════════*)
  399. PROCEDURE BLINK_OFF;
  400.  
  401. {                                     If an EGA or VGA card is installed  }
  402. {                                     this call will change the blink     }
  403. {                                     attribute to a high-intensity attr. }
  404. {                                     This allows you to use hi-intensity }
  405. {                                     colors for a background color       }
  406. (*════════════════════════════════════════════════════════════════════════*)
  407. PROCEDURE BLINK_ON;
  408. {                                     If an EGA or VGA card is installed  }
  409. {                                     this call will change the blink     }
  410. {                                     attribute back to normal.  See      }
  411. {                                     BLINK_OFF above.                    }
  412. (*════════════════════════════════════════════════════════════════════════*)
  413. PROCEDURE SET_BORDER(COLOR : INTEGER);
  414.  
  415. {                                     Sets the border to COLOR.           }
  416. (*════════════════════════════════════════════════════════════════════════*)
  417. procedure SetBlink(On : Boolean);
  418.   {-Enable text mode attribute blinking if On is True}
  419. (*════════════════════════════════════════════════════════════════════════*)
  420. FUNCTION SetEnv(NAME, VALUE : STRING) : BOOLEAN;
  421. {                                     Set environment string, returning   }
  422. {                                     true if successful.  This routine   }
  423. {                                     sets the Master Environment, not a  }
  424. {                                     copy of it like most.               }
  425. (*════════════════════════════════════════════════════════════════════════*)
  426. FUNCTION CAPS_ARE_ON : BOOLEAN;
  427.  
  428. {           Returns TRUE if CAPS LOCK is ON.                  }
  429. (*════════════════════════════════════════════════════════════════════════*)
  430. PROCEDURE CAPS_OFF;
  431.  
  432. {           Turns CAPS LOCK KEY off.                          }
  433. (*════════════════════════════════════════════════════════════════════════*)
  434. PROCEDURE CAPS_ON;
  435.  
  436. {           Turns CAPS LOCK KEY on.                           }
  437. (*════════════════════════════════════════════════════════════════════════*)
  438. PROCEDURE CENTER(Y, ATTRIB : INTEGER; LINE : STRING);
  439.  
  440. {                                     Centers LINE on Line y              }
  441. {                                     using ATTRIB for colors.            }
  442. (*════════════════════════════════════════════════════════════════════════*)
  443. PROCEDURE CENTER_PRINT(LINE     : STRING;
  444.                         LEN     : INTEGER;
  445.                     VAR NEXTPOS : INTEGER;
  446.                         CR      : BOOLEAN);
  447.  
  448. {                                     Prints LINE on Printer Centered on  }
  449. {                                     a line LEN characters long.         }
  450. {                                     NEXTPOS returns the cursor position }
  451. {                                     off the print head. Set CR to True  }
  452. {                                     to issue a WRITELN or False to issue}
  453. {                                     a WRITE.                            }
  454. (*════════════════════════════════════════════════════════════════════════*)
  455. FUNCTION CHECK_KEYBOARD : CHAR;
  456.  
  457. {                                     If a key was pressed returns the    }
  458. {                                     character entered, else returns     }
  459. {                                     character #0.                       }
  460. (*════════════════════════════════════════════════════════════════════════*)
  461. PROCEDURE CLEAR_BUFFER(VAR SCREEN : BUFFER;
  462.                          ATTR : INTEGER);
  463.  
  464. {                                     Clears a BUFFER variable to spaces   }
  465. {                                     with the screen attributes ATTR     }
  466. (*════════════════════════════════════════════════════════════════════════*)
  467. FUNCTION COMBINE(S1, S2 : STRING;
  468.                     MAX : INTEGER;
  469.            INSERT_COMMA : BOOLEAN) : STRING;
  470. {                                                                         }
  471. {    S1 := 'Tom         ';                                                }
  472. {    S2 := 'Hunter      ';                                                }
  473. {    WRITELN(COMBINE(S2,S1,20,TRUE));                                     }
  474. {                                                                         }
  475. {      Result:                         Combines the two variables S1 & S2 }
  476. {         Hunter, Tom                  removing trailing blanks from S1.  }
  477. {                                      If passed TRUE it will insert a    }
  478. {                                      comma between the two variables.   }
  479. {                                      Will always return a string MAX    }
  480. {                                      characters in length.              }
  481. (*════════════════════════════════════════════════════════════════════════*)
  482. FUNCTION  COMMA(VAR VALUE; FIELDWIDTH,
  483.                                 PLACES : INTEGER;
  484.                                  NTYPE : TYPEN) : STRING;
  485.  
  486.  
  487. {        WRITE(COMMA(R,I,J,RNUM));       Will take the real value  }
  488. {                                        R and return a string I   }
  489. {        R := 1234567.89                 characters long with J    }
  490. {        WRITE(COMMA(R,12,2,RNUM));      decimal places.           }
  491. {                                                                  }
  492. {          Result:                                                 }
  493. {            1,234,567.89                RNUM for REAL Numbers     }
  494. {                                        INUM for INTEGER Numbers  }
  495. {                                        LNUM for LONGINT Numbers  }
  496. {                                                                  }
  497. (*════════════════════════════════════════════════════════════════════════*)
  498. FUNCTION DATE_TIME_KEY : STR16;
  499.  
  500. {                                     Returns a string in the form of:      }
  501. { 1990022013211222                    YYYYMMDDHHMMSSHH                      }
  502. {                              YEAR,MONTH,DAY,HOUR,MINURES,SECONDS,HUNDREDS }
  503. {                              See KEY_TO_DATE Function.           }
  504. (*════════════════════════════════════════════════════════════════════════*)
  505. procedure DayWeek(DT : STR8; var DayNum: integer;
  506.                   var DayName: Str3);
  507. {                                                                           }
  508. {                                     Pass this routine a date in the form  }
  509. {                                     of mm-dd-yy, and it will return the   }
  510. {                                     DAYNUM (sun=0, sat=6) and a string    }
  511. {                                     of 3 for the day name (SUN,MON,ETC)   }
  512. (*════════════════════════════════════════════════════════════════════════*)
  513. PROCEDURE DISP_NOPROMPT_MESSAGE(X,Y,LEN,ATTR : INTEGER; MESS : STR80);
  514.  
  515. {                                     Displays a message on screen at X,Y   }
  516. {                                     in the color ATTR.  Mess is padded    }
  517. {                                     with spaces to make it LEN in length. }
  518. (*════════════════════════════════════════════════════════════════════════*)
  519. FUNCTION DUP(MASK : CHAR; N : INTEGER) : STRING;
  520.  
  521. {                                     Returns a string N characters long,   }
  522. {                                     with all characters equal to MASK.    }
  523. (*════════════════════════════════════════════════════════════════════════*)
  524. FUNCTION CREATE_NEW_FILE(FILENAME, MESS : STR80) : BOOLEAN;
  525.  
  526. {                                     Displays a message on screen that     }
  527. {                                     says FILENAME is not found and program}
  528. {                                     is being aborted.  Informs user to    }
  529. {                                     contact MESS for information.         }
  530. {                                     Pressing ALT-F1 at this message will  }
  531. {                                     return TRUE, any other key returns    }
  532. {                                     FALSE.                                }
  533. (*════════════════════════════════════════════════════════════════════════*)
  534. PROCEDURE DISP_MESSAGE(X,Y,LEN,ATTR : INTEGER; MESS : STR80);
  535.  
  536. {                                     Displays a message on screen at X,Y   }
  537. {                                     in the color ATTR.  Mess is padded    }
  538. {                                     with spaces to make it LEN in length. }
  539. {                                     Program is halted until a key is      }
  540. {                                     pressed.  That char is returned in    }
  541. {                                     the global var CH.                    }
  542. (*════════════════════════════════════════════════════════════════════════*)
  543. PROCEDURE DOWN_SOUND;
  544.  
  545. {           Makes a Sound of Decreasing Pitch.                }
  546. (*════════════════════════════════════════════════════════════════════════*)
  547. FUNCTION DRIVE_READY(DRIVE : CHAR) : BOOLEAN;
  548.  
  549. {    IF DRIVE_READY('A') THEN         Returns TRUE if drive is ready.     }
  550. {      ASSIGN(F,'A:TEST.DTA');                                            }
  551. {                                                                         }
  552. (*════════════════════════════════════════════════════════════════════════*)
  553. FUNCTION  ELAP_TIME(T : LONGINT) : LONGINT;
  554.  
  555. {           ELAP_TIME(TIM);           Will Return the number of seconds }
  556. {                                     that have elapsed since the last  }
  557. {                                     call to START_TIMER with TIM, or  }
  558. {                                     any other LONGINT variable.       }
  559. {                                     See START_TIMER.                  }
  560. (*════════════════════════════════════════════════════════════════════════*)
  561. FUNCTION  ELAP_TIME_STR(TIM : LONGINT) : STRING;
  562.  
  563. {           ELAP_TIME_STR(TIM);       Will Return the amount of time    }
  564. {                                     that have elapsed since the last  }
  565. {                                     call to START_TIMER with TIM, or  }
  566. {                                     any other LONGINT variable.       }
  567. {                                     The returned string will be in the}
  568. {                                     form of:
  569. {                                     2 days, 11 hrs, 12 mins, 21 sec   }
  570. {                                                                       }
  571. {                                     Leading numbers will not be shown }
  572. {                                     if they are zero.                 }
  573. {                                                                       }
  574. {                                     If a timer is left running for    }
  575. {                                     25 years, the longest string that }
  576. {                                     would be returned would be 35     }
  577. {                                     characters in length.             }
  578. {                                     (Always PADDED to 35 chars.)      }
  579. (*════════════════════════════════════════════════════════════════════════*)
  580. PROCEDURE ENCRYPT(VAR LINE : STRING; I : INTEGER);
  581.  
  582. {                                     Encrypts a string using I as a key.  }
  583. {                                     See UN_ENCRYPT                       }
  584. (*════════════════════════════════════════════════════════════════════════*)
  585. FUNCTION FILE_EXIST(FILENAME : STRING) : BOOLEAN;
  586.  
  587. (*                                     Returns True if File exists or
  588.                                        false if it does not.              *)
  589. (*                                     Can be used on any type File.      *)
  590. (*════════════════════════════════════════════════════════════════════════*)
  591. FUNCTION FILE_OPEN(VAR F) : BOOLEAN;
  592.  
  593. (*                                     Returns True if File F is Open or
  594.                                        returns False if it is closed.     *)
  595. (*════════════════════════════════════════════════════════════════════════*)
  596. PROCEDURE FILL_SCREEN(X1,Y1,X2,Y2 : INTEGER; CH : CHAR; ATTR : INTEGER);
  597.  
  598. {    FILL_SCREEN(1,1,80,25,'░',$1F);   Fills the section of the screen     }
  599. {                                      definded by X1, Y1, X2, X2 with     }
  600. {                                      character CH, in the text attribute }
  601. {                                      of ATTR.                            }
  602. {                                      $1F = Color 1 for Background Color  }
  603. {                                          and color F (15) for foreground }
  604. (*════════════════════════════════════════════════════════════════════════*)
  605. PROCEDURE FW(X,Y : INTEGER; ATTR : BYTE; LINE : STR80);
  606.  
  607. {        FW(X,Y,$07,S);               Writes the value of string  }
  608. {          or                         S at X,Y with 0 Background  }
  609. {        FW(X,Y,$01,S1+S2+'X');       color and 7 Foreground.     }
  610. {                                     This Procedure Supports     }
  611. {                                     43 line mode. (1 >= Y <= 43 }
  612. {                             $07 = Color 0 for Background Color  }
  613. {                                      and color 7 for foreground }
  614. (*════════════════════════════════════════════════════════════════════════*)
  615. PROCEDURE FWB(VAR SCREEN : BUFFER;
  616.                 X,Y,ATTR : INTEGER;
  617.                 INSTRING : STR80);
  618.  
  619. {                                     Same as FW procedure except it writes}
  620. {                                     INSTRING to a BUFFER variable.      }
  621. (*════════════════════════════════════════════════════════════════════════*)
  622. FUNCTION GET_FILE_INFO(FILENAME : STRING) : STR80;
  623.  
  624. {   INSTRING := GET_FILE_INFO('C:\AUTOEXEC.BAT');                         }
  625.  
  626. {                                     Returns a string containing         }
  627. {                                     file size, date, and time.          }
  628. {                                                                         }
  629. {                                     "      345  6/04/90 12:44p"         }
  630. (*════════════════════════════════════════════════════════════════════════*)
  631. FUNCTION GET_FILE_NAME(MASK : STRING; DEL : BOOLEAN) : STRING;
  632.  
  633. {   INSTRING := GET_FILE_NAME('*.*',TRUE);
  634.  
  635. {                                     Pops up a window displaying         }
  636. {                                     filenames matching filespec.        }
  637. {                                     Returns a selected filename         }
  638. {                                     and allows deletions if TRUE.       }
  639. {                                     If <ESC> is pressed, will return a  }
  640. {                                     null string                         }
  641. (*════════════════════════════════════════════════════════════════════════*)
  642. PROCEDURE GOTOXY43(X,Y : INTEGER);
  643.  
  644. {           GOTOXY43(10,43);          This will move the cursor to    }
  645. {                                     10,43 if 43 line mode is active }
  646. {                                     Even in 25 line mode this will  }
  647. {                                     work if y is <= 25              }
  648. (*════════════════════════════════════════════════════════════════════════*)
  649. FUNCTION INT_STR(I,LEN : INTEGER) : STR80;
  650.  
  651. {         INT_STR(2300,6);            This will return a string       }
  652. {                                     "  2300"                        }
  653. (*════════════════════════════════════════════════════════════════════════*)
  654. FUNCTION JULIAN(DT : STR8) : LONGINT;
  655.  
  656. {         JULIAN(DATE)                Returns a LONGINT value that    }
  657. {                                     can be used to calculate the    }
  658. {                                     difference between two dates.   }
  659. {                                     DT must be in the form mm-dd-yy }
  660. (*════════════════════════════════════════════════════════════════════════*)
  661. FUNCTION JulToMDY(JulianDay: longint) : STR8;
  662.  
  663. {         JULTOMDY(LONG)              Returns a DATE in the form of   }
  664. {                                     mm-dd-yy.  See JULIAN.          }
  665. (*════════════════════════════════════════════════════════════════════════*)
  666. FUNCTION KEY_TO_DATE(ST : STRING) : STRING;
  667.  
  668. {                                     Converts a DATE_TIME_KEY back   }
  669. {                                     to a valid date and time.       }
  670. {                                     See DATE_TIME_KEY Function.     }
  671. (*════════════════════════════════════════════════════════════════════════*)
  672. PROCEDURE LINES25;
  673.  
  674. {                                     After a call to LINES43, this   }
  675. {                                     will return you to 25 line mode.}
  676. (*════════════════════════════════════════════════════════════════════════*)
  677. PROCEDURE LINES43;
  678.  
  679. {                                     If EGA card is present this     }
  680. {                                     will put you in 43 line mode.   }
  681. (*════════════════════════════════════════════════════════════════════════*)
  682. FUNCTION LONGINT_STR(I : LONGINT; LEN : INTEGER) : STR80;
  683.  
  684. {     LONGINT_STR(230000,10);            This will return a string       }
  685. {                                     "    230000"                       }
  686. (*════════════════════════════════════════════════════════════════════════*)
  687. FUNCTION NUM_LOCK_IS_ON : BOOLEAN;
  688.  
  689. {           Returns TRUE if NUM-LOCK is ON.                   }
  690. (*════════════════════════════════════════════════════════════════════════*)
  691. PROCEDURE NUM_LOCK_OFF;
  692.  
  693. {           Turns NUM LOCK KEY off.                           }
  694. (*════════════════════════════════════════════════════════════════════════*)
  695. PROCEDURE NUM_LOCK_ON;
  696.  
  697. {           Turns NUM LOCK KEY on.                            }
  698. (*════════════════════════════════════════════════════════════════════════*)
  699. FUNCTION  PAD(S : STRING; LEN : INTEGER) : STRING;
  700.  
  701. {          PAD(S,20);                 Will return S + spaces exactly 20   }
  702. {                                     characters long. Padded with spaces }
  703. {                                     at the end of S.                    }
  704. (*════════════════════════════════════════════════════════════════════════*)
  705. Function PackKey(Dte, Tme : str8) : longint;
  706.  
  707. {                                               See UnPackKey.            }
  708. {  var L : longint;                            Set Parms to '' to         }
  709. {                                              return key for current     }
  710. {     L := PackKey('10-11-91','12:14:22');     date & time.               }
  711. (*════════════════════════════════════════════════════════════════════════*)
  712. FUNCTION  PAD_LEFT(S : STRING; LEN : INTEGER) : STRING;
  713.  
  714. {          PAD_LEFT(S,20);            Will return S + spaces exactly 20   }
  715. {                                     characters long. Padded with spaces }
  716. {                                     at the beginning of S.              }
  717. (*════════════════════════════════════════════════════════════════════════*)
  718. FUNCTION  PAD_CH(S : STRING; LEN : INTEGER; CH : CHAR) : STRING;
  719.  
  720. {          PAD_CH(S,20,'A');          Will return S + CH's   exactly 20   }
  721. {                                     characters long.  S will be padded  }
  722. {                                     with 'A's until it is 20 characters }
  723. {                                     in length.                          }
  724. (*════════════════════════════════════════════════════════════════════════*)
  725. PROCEDURE PATHEXEC(COMMAND : PATHSTR; PARMS : STRING);
  726.  
  727. {                                     Future use only                     }
  728. (*════════════════════════════════════════════════════════════════════════*)
  729. PROCEDURE POP_WINDOW(X1,Y1,X2,Y2 : INTEGER; STYLE : INTEGER; ATTR : BYTE);
  730.  
  731. {                                     Pops up a Window.  The window size  }
  732. {                                     is determined by X1,Y1,X2,Y2.       }
  733. {                                     These parameters work exactly as    }
  734. {                                     the window command in Turbo Pascal. }
  735. {                                                                         }
  736. {                                     If STYLE is set to 0, there will be }
  737. {                                     no border around the window.  If it }
  738. {                                     is set to 1 there will be a single  }
  739. {                                     line border.  If it is set to 2     }
  740. {                                     the border will be a double line.   }
  741. {                                     0,1,2 will place a shadow at bottom }
  742. {                                     and right side.                     }
  743. {                                                                         }
  744. {                                     If STYLE is set to 10, there will be }
  745. {                                     no border around the window.  If it  }
  746. {                                     is set to 11 there will be a single  }
  747. {                                     line border.  If it is set to 12     }
  748. {                                     the border will be a double line.    }
  749. {                                     10,11,12 will not place a shadow.    }
  750. {                                                                         }
  751. {                                     ATTR is the color attribute of the  }
  752. {                                     window.                             }
  753. (*════════════════════════════════════════════════════════════════════════*)
  754. PROCEDURE POP_MESSAGE(        X,Y : INTEGER;
  755.                      BORDER, ATTR : BYTE;
  756.                             MATTR : BYTE;
  757.                           MESSAGE : STR80);
  758.  
  759. {                                    Pops a window at X,Y around MESSAGE  }
  760. {                                    If X is set to 0, the window is      }
  761. {                                    centered on the screen horizontally  }
  762. {                                    X,Y = Upper Left Corner of window    }
  763. {                                    BORDER = (See POP_WINDOW)            }
  764. {                                    ATTR   = Color of border             }
  765. {                                    MATTR  = Color of MESSAGE            }
  766. {                                    MESSAGE = Message to be displayed    }
  767. (*════════════════════════════════════════════════════════════════════════*)
  768. PROCEDURE POP_WINDOW_TITLE(   X,Y,X1,Y1 : INTEGER;
  769.                            BORDER, ATTR : BYTE;
  770.                                   TATTR,
  771.                                      TY : BYTE;
  772.                                   TITLE : STR80);
  773.  
  774. {                                     Pops a window (X,Y,X1,Y1) same as   }
  775. {                                     POP_WINDOW.  TITLE will be centered }
  776. {                                     based on the window width, on line  }
  777. {                                     TY in the color of TATTR.           }
  778. (*════════════════════════════════════════════════════════════════════════*)
  779. PROCEDURE PRINT_SCREEN(X1,Y1,X2,Y2 : INTEGER; EXT : BOOLEAN);
  780.  
  781. {                                                                         }
  782. {    PRINT_SCREEN(1,1,80,25,TRUE);    Prints a section of the screen,     }
  783. {                                     bounded by the coordinates.  The    }
  784. {                                     screen coordinates are the same as  }
  785. {                                     Turbo Pascal's WINDOW procedure.    }
  786. {                                     To print IBM Extended Graphic       }
  787. {                                     characters use TRUE.  FALSE will    }
  788. {                                     print spaces instead of graphics.   }
  789. {                                     The above example would print the   }
  790. {                                     entire screen.                      }
  791. (*════════════════════════════════════════════════════════════════════════*)
  792. FUNCTION  PRINTER_NOT_READY : BOOLEAN;
  793.  
  794. {           Returns TRUE if the Line Printer is not ready.    }
  795. (*════════════════════════════════════════════════════════════════════════*)
  796. FUNCTION PRINTER_READY : BOOLEAN;
  797. {                                                                         }
  798. {    IF PRINTER_READY THEN            If Printer is NOT READY, pops up    }
  799. {      WRITELN(LST,'HELLO WORLD');    a Window, asking for you to ready   }
  800. {                                     it.  Pressing <ESC> returns FALSE.  }
  801. {                                     Turning Print ON, (or if it was     }
  802. {                                     already on) returns TRUE.           }
  803. (*════════════════════════════════════════════════════════════════════════*)
  804. FUNCTION PROGRAM_LOCATION : STRING;
  805. {                                                                          }
  806. {                                     Returns a string containing the      }
  807. {                                     drive and complete pathname of       }
  808. {                                     where the currenly executing program }
  809. {                                     is located.                          }
  810. (*════════════════════════════════════════════════════════════════════════*)
  811. FUNCTION RANDOM_NUMBER(LOW, HIGH : INTEGER) : INTEGER;
  812.  
  813. (*                                     Produces a Random number between
  814.                                        0 and 99.  if LOW is less than 0
  815.                                        or HIGH is greater than 99 will
  816.                                        always return 0.  Do not call this
  817.                                        routine from a loop.  It uses 1/100
  818.                                        of a second from the system clock
  819.                                        to generate the numbers.  If called
  820.                                        from within a loop it will return
  821.                                        a sequence or pattern to its numbers.
  822.                                        Works fine for a ocassional Random
  823.                                        Number.                            *)
  824. (*════════════════════════════════════════════════════════════════════════*)
  825. PROCEDURE READCH(VAR CH : CHAR; ECHO : BOOLEAN);
  826.  
  827. {       READCH(CH,TRUE);          TRUE  for echo on screen.       }
  828. {                                 FALSE for no echo.              }
  829. {                                 If ALT-F10 is pressed it        }
  830. {                                 will call SHOW_VERSION.         }
  831. {                                 If the global var ut.timex      }
  832. {                                 is set to other than 0, the     }
  833. {                                 time is continually updated     }
  834. {                                 on the screen at ut.timex,      }
  835. {                                 ut.timey until a key is pressed }
  836. {                                                                 }
  837. {          also converts F-KEYS to FUNC1..FUNC10, HOMEKEY,        }
  838. {          UP, DOWN, LEFT, RIGHT, ECT.                            }
  839. {                                                                 }
  840. {          READCH(CH,TRUE);                                       }
  841. {          IF CH = FUNC1 THEN CALL_HELP;                          }
  842. (*════════════════════════════════════════════════════════════════════════*)
  843. PROCEDURE READCHT(VAR CH : CHAR; ECHO : BOOLEAN; TOO : LONGINT);
  844.  
  845. {   Waits TOO seconds for a key to be pressed, IF no key is pressed       }
  846. {   within TOO seconds, Routine is exited leaving CH unchanged.           }
  847. {                                                                         }
  848. {   READCHT(CH,FALSE,10);             Waits 10 seconds for a key to be    }
  849. {                                     pressed, If not CH is unchanged.    }
  850. (*════════════════════════════════════════════════════════════════════════*)
  851. PROCEDURE READCHTIME(VAR CH : CHAR; ECHO : BOOLEAN; X,Y : INTEGER);
  852.  
  853. {                                     This routine is for backward     }
  854. {                                     compatibility only.  Use READCH  }
  855. {                                     instead.  By setting the global  }
  856. {                                     vars UT.TIMEX and UT.TIMEY the   }
  857. {                                     time is kept automatically using }
  858. {                                     READCH                           }
  859. {                                                                      }
  860. {                                     Continually Updates TIME at X,Y  }
  861. {                                     until a key is pressed.  That    }
  862. {                                     key is returned in CH.           }
  863. {                                     If CH = 'M' Time will be in      }
  864. {                                     Military Time Format.            }
  865. (*════════════════════════════════════════════════════════════════════════*)
  866. PROCEDURE READ_DIGIT(    X,Y : INTEGER;
  867.                    VAR VALUE;          
  868.                   RIGHT_JUST : INTEGER;
  869.                    LOW, HIGH : LONGINT;
  870.                        NTYPE : TYPEN);
  871.  
  872. {                                     Reads a INT OR A LONGINT value from  }
  873. {                                     input.                               }
  874. {                                     This procedure should be used when   }
  875. {                                     calculator style input is desired.   }
  876. (*════════════════════════════════════════════════════════════════════════*)
  877. PROCEDURE READ_MONEY(X,Y : INTEGER;
  878.                    VAR R : REAL;
  879.                  DPLACES : INTEGER;
  880.               RIGHT_JUST : INTEGER;
  881.                LOW, HIGH : REAL);
  882.  
  883. {                                     Reads a Real value from input.       }
  884. {                                     This procedure should be used when   }
  885. {                                     calculator style input is desired.   }
  886. (*════════════════════════════════════════════════════════════════════════*)
  887. PROCEDURE READ_R(     X,Y : INTEGER;
  888.                     VAR R : REAL;
  889.                       MIN,
  890.                       MAX : REAL;
  891.                    PLACES : INTEGER;
  892.                RIGHT_JUST : INTEGER;
  893.                    ICOMMA : BOOLEAN);
  894.  
  895. {                                     Reads a Real value from input.       }
  896. {                                     This procedure should be used instead}
  897. {                                     of the old READ_REAL.                }
  898. (*════════════════════════════════════════════════════════════════════════*)
  899. PROCEDURE READ_I(     X,Y : INTEGER;
  900.                     VAR R : INTEGER;
  901.                       MIN,
  902.                       MAX : INTEGER;
  903.                RIGHT_JUST : INTEGER;
  904.                    ICOMMA : BOOLEAN);
  905.  
  906. {                                     Reads a Integer value from input.     }
  907. {                                     This procedure should be used instead }
  908. {                                     of the old READ_INT.                  }
  909. (*════════════════════════════════════════════════════════════════════════*)
  910. PROCEDURE READ_L(     X,Y : INTEGER;
  911.                     VAR R : LONGINT;
  912.                       MIN,
  913.                       MAX : LONGINT;
  914.                RIGHT_JUST : LONGINT;
  915.                    ICOMMA : BOOLEAN);
  916.  
  917. {                                     Reads a LongInt value from intput.    }
  918. (*════════════════════════════════════════════════════════════════════════*)
  919. PROCEDURE READ_INT(X,Y,LEN   : INTEGER;
  920.                     PATTR    : INTEGER;
  921.                     PROMPT   : STR80;
  922.                     IATTR    : INTEGER;
  923.                     VAR R    : INTEGER;
  924.                     LOW,HIGH : INTEGER;
  925.                     EXITCH   : ETYPE;
  926.                     ICOMA    : BOOLEAN;
  927.                     TX, TY   : INTEGER;
  928.                     CH       : CHAR);
  929. (*
  930.  
  931.   This procedure is provided only for backward compatibility.  Use the
  932.   new procedure READ_I for keyboard in put of integer type variables.
  933.  
  934.   WHERE         X  = X Location of where Prompt will start.
  935.                 Y  = Y Location of where Prompt will start.
  936.               LEN  = Maximum Length of Field to be input.
  937.             PATTR  = Color attributes of Prompt.
  938.            PROMPT  = Prompt that will appear AT X,Y
  939.             IATTR  = Color attributes of Input Field.
  940.                 R  = Variable Parameter being Edited.
  941.               LOW  = Lowest Value Allowed.
  942.              HIGH  = Highest Value Allowed.
  943.            EXITCH  = Characters Entered From Keyboard used to Exit Edit.
  944.             ICOMA  = True for comma insertion, false for no comma.
  945.               TX,
  946.               TY   = Location on screen to update time (TX = 0 for
  947.                      no time)
  948.               CH   = 'M' for Military Time, else AM/PM
  949.  
  950.                   If NOCONV is included in EXITCH then
  951.                   LEFT or RIGHT is not converted to
  952.                   UP or DOWN if in first or last
  953.                   position.
  954.  
  955.                   If CLEAR is included in EXITCH then
  956.                   the value being edited is set to
  957.                   spaces.
  958.  
  959.                   Insert keys & Delete keys are active
  960.  
  961. *)
  962. (*════════════════════════════════════════════════════════════════════════*)
  963. PROCEDURE READ_ONLY(NAME : STRING);
  964.  
  965. {                                     Sets Filename "NAME" to READ-ONLY.}
  966. (*════════════════════════════════════════════════════════════════════════*)
  967. PROCEDURE READ_REAL(X,Y,LEN  : INTEGER;
  968.                     PATTR    : INTEGER;
  969.                     PROMPT   : STR80;
  970.                     IATTR    : INTEGER;
  971.                     VAR R    : REAL;
  972.                     DPLACES  : INTEGER;
  973.                     LOW,HIGH : REAL;
  974.                     EXITCH   : ETYPE;
  975.                     ICOMA    : BOOLEAN;
  976.                     TX, TY   : INTEGER;
  977.                     CH       : CHAR);
  978. (*
  979.   This procedure is provided only for backward compatibility.  Use the
  980.   new procedure READ_R for keyboard in put of real type variables.
  981.  
  982.   WHERE         X  = X Location of where Prompt will start.
  983.                 Y  = Y Location of where Prompt will start.
  984.               LEN  = Length of Field to be Input.
  985.             PATTR  = Color Attributes of Prompt.
  986.            PROMPT  = Prompt that will appear at X,Y
  987.             IATTR  = Color Attributes of Input Field.
  988.                 R  = Variable Parameter being Edited.
  989.           DPLACES  = Number of Decimal Places.
  990.               LOW  = Lowest Value Allowed.
  991.              HIGH  = Highest Value Allowed.
  992.            EXITCH  = Characters Entered From Keyboard Used to Exit Edit.
  993.             ICOMA  = True for Comma Insertion, False for no commas.
  994.               TX,
  995.               TY   = Location on Screen to Update Time (TX = 0 for
  996.                      no Time.)
  997.               CH   = 'M' for Military Time, else AM/PM
  998.  
  999.                   If NOCONV is included in EXITCH then
  1000.                   LEFT or RIGHT is not converted to
  1001.                   UP or DOWN if in first or last
  1002.                   position.
  1003.  
  1004.                   If CLEAR is included in EXITCH then
  1005.                   the value being edited is set to
  1006.                   spaces.
  1007.  
  1008.                   Insert keys & Delete keys are active
  1009. *)
  1010. (*════════════════════════════════════════════════════════════════════════*)
  1011. FUNCTION READ_SCREEN(X,Y : INTEGER) : CHAR;
  1012.  
  1013. {   CH := READ_SCREEN(10,15);                                             }
  1014. {                                     Returns the character on the screen }
  1015. {                                     at X,Y. (at 10,15 in this case)     }
  1016. (*════════════════════════════════════════════════════════════════════════*)
  1017. PROCEDURE READSTR(X,Y,LEN : INTEGER;
  1018.                     PATTR : INTEGER;
  1019.                    PROMPT : STR80;
  1020.                     IATTR : INTEGER;
  1021.              VAR INSTRING : STR80;
  1022.                     VALID : ETYPE;
  1023.                   CANEDIT : CTYPE;
  1024.                    EXITCH : ETYPE;
  1025.                    XLOC,
  1026.                    YLOC   : INTEGER;
  1027.                    CH1    : CHAR);
  1028. (*
  1029.  
  1030.   WHERE         X  = X Location of Where Prompt will start.
  1031.                 Y  = Y Location of Where Prompt will start.
  1032.               LEN  = Maximum Length of Input Field.
  1033.             PATTR  = Color Attributes of Prompt.
  1034.            PROMPT  = Prompt that will appear at X,Y.
  1035.             IATTR  = Color Attributes of Input Field.
  1036.          INSTRING  = Variable Parameter being Edited.
  1037.             VALID  = Valid Characters that can be entered for Field.
  1038.           CANEDIT  = Which Positions of Field that can be edited.
  1039.            EXITCH  = Characters Entered from Keyboard Used to Exit Edit.
  1040.             XLOC,
  1041.             YLOC   = Location on screen to Update Time (XLOC = 0 for
  1042.                      no time.) Add 100 to XLOC to initialize the
  1043.                      cursor at the end of the input field instead of at
  1044.                      the beginning.
  1045.                      (Add 100 to YLOC for Auto Capitilization of Words)
  1046.                      (Add 200 to YLOC for Auto Caps of all characters )
  1047.              CH1   = 'M' for Military Time, else AM/PM
  1048.  
  1049.  
  1050.       If you are in the first position of a field and press the RIGHT
  1051.       ARROW, CH is converted to UP. If you are in the last position of
  1052.       a field and press RIGHT ARROW, CH is converted to DOWN.
  1053.  
  1054.         UNLESS: If you include NOCONV in your EXITCH, conversion does
  1055.         not take place.  If you are in the first postion of a field,
  1056.         pressing LEFT ARROW will cause you to exit and leave the value
  1057.         of CH set to LEFT.  If you are in the last position of a field
  1058.         pressing RIGHT ARROW will cause you to exit and leave the value
  1059.         CH set to RIGHT.
  1060.  
  1061.         If CLEAR is included in EXITCH then the value being edited is
  1062.         set to spaces.
  1063.  
  1064.         Insert keys & Delete keys are active.
  1065.  
  1066. *)
  1067. (*════════════════════════════════════════════════════════════════════════*)
  1068. PROCEDURE READ_STR(X,Y          : INTEGER;
  1069.                    VAR INSTRING : STR80;
  1070.                    MASK         : STR80);
  1071. (*
  1072.  
  1073.   WHERE         X  = X Location of Where Prompt will start.
  1074.                 Y  = Y Location of Where Prompt will start.
  1075.          INSTRING  = Variable Parameter being Edited.
  1076.              MASK  = Input mask:
  1077.  
  1078.               ' '  Allows any keyboard input at this location.
  1079.               'c'  Same as ' ' except turns on Auto Word Capitalization
  1080.                    for entire string.
  1081.               'y'  Either a 'Y' or an 'N' is allowed in this position.
  1082.                    If lower case is entered it is automatically converted
  1083.                    to uppercase.
  1084.               'A'  Any character is allowed.  Alpha at this location is
  1085.                    converted to uppercase.
  1086.               '0'  Numeric.  Characters 0 thru 9 only are allowed.
  1087.               '1'  Numeric.  Characters 0 thru 9 and ' ' are allowed.
  1088.               '.'  Numeric.  Characters 0 thru 9 and '.' are allowed.
  1089.               '!'  Numeric.  Characters 0 thru 9 and ' ' and '.' are allowed.
  1090.               '+'  Numeric.  Characters 0 thru 9 and ' ' and '.' and '+'
  1091.                    and '-' are allowed.
  1092.               'x'  Restricts this position from being edited.  The cursor
  1093.                    will skip this field.
  1094.  
  1095.               'Any other character in the mask' will be inserted into the
  1096.                input string.
  1097.  
  1098.               Examples:
  1099.  
  1100.                   read_str(30,12,name,'(111)x000-0000');
  1101.  
  1102.                   will initialize positions 1,5 and 10 to :  '(   )    -    ';
  1103.                   will allow spaces or digits for area code.
  1104.                   will allow only digits for number.
  1105.  
  1106. *)
  1107. (*════════════════════════════════════════════════════════════════════════*)
  1108. PROCEDURE READSTR_BIG(X,Y,LEN : INTEGER;
  1109.                         PATTR : INTEGER;
  1110.                        PROMPT : STR80;
  1111.                         IATTR : INTEGER;
  1112.                  VAR INSTRING : STRING;
  1113.                         VALID : ETYPE;
  1114.                       CANEDIT : CTYPE;
  1115.                        EXITCH : ETYPE;
  1116.                        XLOC,
  1117.                        YLOC   : INTEGER;
  1118.                        CH1    : CHAR;
  1119.                        WIN    : INTEGER);
  1120.  
  1121. (*                                     Scrolling string Input.            *)
  1122. (*                                     All parameters are the same as     *)
  1123. (*                                     READSTR except the addition of WIN.*)
  1124. (*                                     WIN is the size of the input field *)
  1125. (*                                     for this input, LEN is the total   *)
  1126. (*                                     possible length of INSTRING.       *)
  1127. (*                                                                        *)
  1128. (*                                     *** CANEDIT is set automaticall    *)
  1129. (*                                         to all positions   ****        *)
  1130. (*                                                                        *)
  1131. (*                                     Insert keys & Delete keys are      *)
  1132. (*                                     active.                            *)
  1133. (*════════════════════════════════════════════════════════════════════════*)
  1134. PROCEDURE READ_WRITE(NAME : STRING);
  1135.  
  1136. {                                     Sets Filename "NAME" to READ-WRITE.}
  1137. (*════════════════════════════════════════════════════════════════════════*)
  1138. FUNCTION REAL_STR(R : REAL; LEN, PLACES : INTEGER) : STR80;
  1139.  
  1140. {      REAL_STR(123.22,10,2);         This would return a string         }
  1141. {                                     "    123.22"                       }
  1142. (*════════════════════════════════════════════════════════════════════════*)
  1143. PROCEDURE REBOOT;
  1144.  
  1145. {                                     Performs a re-boot of the computer }
  1146. (*════════════════════════════════════════════════════════════════════════*)
  1147. PROCEDURE REBUILD_LINE(Y : INTEGER; STR : BUF160);
  1148.  
  1149. {    DEFINE A VARIABLE:                                         }
  1150. {         VAR                                                   }
  1151. {           S : BUF160;                                         }
  1152. {                                                               }
  1153. {          SAVE_LINE(5,S);       Saves Line 5 in S.             }
  1154. {          REBUILD_LINE(5,S);    Restores Line 5 from S.        }
  1155. {                                                               }
  1156. {          This routine saves screen characters and attributes  }
  1157. {                                                               }
  1158. {   CAUTION ! IN 43 LINE MODE, USE ONLY FOR FIRST 25 LINES      }
  1159. (*════════════════════════════════════════════════════════════════════════*)
  1160. PROCEDURE REBUILD_SCREEN(VAR SCREEN : BUFFER);
  1161.  
  1162. {    SEE SAVE_SCREEN                                          }
  1163. {                                                             }
  1164. {   CAUTION ! In 43 Line Mode, Will only Restore top 25 lines.}
  1165. (*════════════════════════════════════════════════════════════════════════*)
  1166. PROCEDURE SAVE_LINE(Y : INTEGER; VAR STR : BUF160);
  1167.  
  1168. {    DEFINE A VARIABLE:                                         }
  1169. {         VAR                                                   }
  1170. {           S : BUF160;                                         }
  1171. {                                                               }
  1172. {          SAVE_LINE(5,S);       Saves Line 5 in S.             }
  1173. {          REBUILD_LINE(5,S);    Restores Line 5 from S.        }
  1174. {                                                               }
  1175. {          This routine saves screen characters and attributes  }
  1176. {                                                               }
  1177. {   CAUTION ! IN 43 LINE MODE, USE ONLY FOR FIRST 25 LINES      }
  1178. (*════════════════════════════════════════════════════════════════════════*)
  1179. PROCEDURE SAVE_SCREEN(VAR SCREEN : BUFFER);
  1180.  
  1181. {    DEFINE A VARIABLE:                                       }
  1182. {         VAR                                                 }
  1183. {           S : BUFFER;                                       }
  1184. {                                                             }
  1185. {          SAVE_SCREEN(S);       Saves Current Screen in S.   }
  1186. {          REBUILD_SCREEN(S);    Restores Screen to S.        }
  1187. {                                                             }
  1188. {   CAUTION ! IN 43 LINE MODE, WILL ONLY SAVE TOP 25 LINES    }
  1189. (*════════════════════════════════════════════════════════════════════════*)
  1190. FUNCTION SCREEN_ATTR(X,Y : INTEGER) : BYTE;
  1191.  
  1192. {   TEXTATTR := SCREEN_ATTR(10,20);                                       }
  1193. {                                     Returns the Screen Color at X,Y.    }
  1194. (*════════════════════════════════════════════════════════════════════════*)
  1195. PROCEDURE SET_ATTR(X : LINE_SET; Y : INTEGER;ATTRIB : BYTE);
  1196.  
  1197. {           SET_ATTR([1..4,10],Y,$07);                        }
  1198.  
  1199. {           Sets the Columns 1 thru 4 and 10 on line Y        }
  1200. {           to  Background Color 0 (BLACK)                    }
  1201. {           and Foreground COLOR 7 (LIGHTGRAY)                }
  1202. {   CAUTION ! Use this only above line 26 if in 43 line mode. }
  1203. {           Leaves text on screen unchanged                   }
  1204. {                         $07 = Color 0 for Background Color  }
  1205. {                                  and color 7 for foreground }
  1206. (*════════════════════════════════════════════════════════════════════════*)
  1207. PROCEDURE SCREEN_ON;
  1208.  
  1209. {                                     Turns the Screen back on after    }
  1210. {                                     it has been turned off with       }
  1211. {                                     SCREEN_OFF                        }
  1212. (*════════════════════════════════════════════════════════════════════════*)
  1213. PROCEDURE SCREEN_OFF;
  1214.  
  1215. {                                     Turns the Screen off to a black   }
  1216. {                                     screen.  Use SCREEN_ON to turn    }
  1217. {                                     it back on .                      }
  1218. (*════════════════════════════════════════════════════════════════════════*)
  1219. PROCEDURE SCROLL_LOCK_ON;
  1220. {                                                                         }
  1221. {           Turns the Scroll Lock key on.                                 }
  1222. (*════════════════════════════════════════════════════════════════════════*)
  1223. PROCEDURE SCROLL_LOCK_OFF;
  1224. {                                                                         }
  1225. {           Turns the Scroll Lock key off.                                }
  1226. (*════════════════════════════════════════════════════════════════════════*)
  1227. FUNCTION SCROLL_LOCK_IS_ON : BOOLEAN;
  1228. {                                                                         }
  1229. {           Returns TRUE if the Scroll Lock Key is on else returns FALSE. }
  1230. (*════════════════════════════════════════════════════════════════════════*)
  1231. PROCEDURE SET_ATTR_BUFFER(VAR SC : BUFFER;
  1232.                                X : LINE_SET;
  1233.                                Y : INTEGER;
  1234.                           ATTRIB : BYTE);
  1235.  
  1236. {           SET_ATTR_BUFFER(SC,[1..4,10],Y,$07);                        }
  1237.  
  1238. {           This routine alters the attributes of a BUFFER    }
  1239. {           screen, not the active video screen.              }
  1240.  
  1241. {           Sets the Columns 1 thru 4 and 10 on line Y        }
  1242. {           to  Background Color 0 (BLACK)                    }
  1243. {           and Foreground COLOR 7 (LIGHTGRAY)                }
  1244. {   CAUTION ! Use this only above line 26 if in 43 line mode. }
  1245. {           Leaves text on screen unchanged                   }
  1246. {                         $07 = Color 0 for Background Color  }
  1247. {                                  and color 7 for foreground }
  1248. (*════════════════════════════════════════════════════════════════════════*)
  1249. PROCEDURE SET_ATTR_BOX(X1,Y1,X2,Y2,ATT : INTEGER);
  1250.  
  1251. (*                                     Sets Screen Attributes of the box
  1252.                                        X1,Y1,X2,Y2 to the Colors of ATT.
  1253.                                        Coordinates are the same as Turbo
  1254.                                        Pascals Window Procedure.          *)
  1255. {                                      Leaves text on screen unchanged     }
  1256. (*════════════════════════════════════════════════════════════════════════*)
  1257. PROCEDURE SET_CURSOR(CURS : CURTYPE);
  1258.  
  1259. {    SET_CURSOR(NONE);          Makes Cursor Invisable.    }
  1260. {    SET_CURSOR(UNDERLINE);     Makes Normal Cursor.       }
  1261. {    SET_CURSOR(BLOCK);         Makes Block Cursor.        }
  1262. {    SET_CURSOR(HALF);          Makes a Half Cursor.       }
  1263.  
  1264. {                               Cursor is returned to      }
  1265. {                               normal on exit of program, }
  1266. {                               unless RESET_CURSOR is set }
  1267. {                               to FALSE                   }
  1268. (*════════════════════════════════════════════════════════════════════════*)
  1269. FUNCTION SHIFT_KEYS(KEY : CHAR) : BOOLEAN;
  1270.  
  1271. {  KEY = 'R' for Right, 'L' for Left, 'C' for Control, 'A' for Alt }
  1272.  
  1273. {  Returns true if key is pressed                                  }
  1274. (*════════════════════════════════════════════════════════════════════════*)
  1275. PROCEDURE SHOW_VERSION;
  1276.  
  1277. {           Displays a Window and the contents of the         }
  1278. {           global variable    VERSION.                       }
  1279. {           Also displays the version of UTILITY your program }
  1280. {           was compiled with.                                }
  1281. {           From any of UTILITY read procedures pressing      }
  1282. {           ALT-F10 will call this routine                    }
  1283. (*════════════════════════════════════════════════════════════════════════*)
  1284. FUNCTION  SPACES(NUM : Word) : STRING;
  1285.  
  1286. {            S := SPACES(25);         Will Initialize the variable S   }
  1287. {                                     to 25 spaces.                    }
  1288. (*════════════════════════════════════════════════════════════════════════*)
  1289. FUNCTION STRIP(ST : STRING; IMBED : BOOLEAN) : STRING;
  1290.  
  1291. {                                     Removes Leading and Trailing      }
  1292. {                                     spaces from a string variable.    }
  1293. {                                     If IMBED is set to true it will   }
  1294. {                                     also removes all but 1 blank      }
  1295. {                                     between words.                    }
  1296. (*════════════════════════════════════════════════════════════════════════*)
  1297. PROCEDURE START_TIMER(VAR T : LONGINT);
  1298.  
  1299. {           START_TIMER(TIM);         Will Start a timer by setting the }
  1300. {                                     value of TIM (or any LONGINT) to  }
  1301. {                                     a time related value.             }
  1302. {                                     By calling ELAP_TIME with this    }
  1303. {                                     same variable, you can tell how   }
  1304. {                                     many seconds has elapsed.         }
  1305. {                                     This routine works accurately     }
  1306. {                                     for over 30 years.                }
  1307. (*════════════════════════════════════════════════════════════════════════*)
  1308. PROCEDURE StuffBuffer(S : STR16);
  1309.  
  1310. {         StuffBuffer('DIR');         Will Stuff S into the keyboard    }
  1311. {                                     buffer, just as if it were        }
  1312. {                                     entered from the keyboard.        }
  1313. (*════════════════════════════════════════════════════════════════════════*)
  1314. PROCEDURE UN_ENCRYPT(VAR LINE : STRING; I : INTEGER);
  1315.  
  1316. {                                     UN-ENCRYPTS A STRING USING I AS KEY.}
  1317. {                                     See ENCRYPT.                        }
  1318.  
  1319. (*════════════════════════════════════════════════════════════════════════*)
  1320. Function UnPackKey(PK : longint) : str20;
  1321.  
  1322. {                                                 See PackKey             }
  1323. {                                                 Returns a string equal  }
  1324. {  write(UnPackKey(L)); ==> 10-10-91 12:14:22     to the Date & Time      }
  1325. {                                                 Packed into L.          }
  1326. (*════════════════════════════════════════════════════════════════════════*)
  1327. FUNCTION  UPPERCASE(S : STRING) : STRING;
  1328.  
  1329. {            S := UPPERCASE(S);       Will Uppercase all Lowercase    }
  1330. {                                     characters in the string S.     }
  1331. (*════════════════════════════════════════════════════════════════════════*)
  1332. PROCEDURE UP_SOUND;
  1333.  
  1334. {           Makes a Sound of Increasing Pitch.                }
  1335. (*════════════════════════════════════════════════════════════════════════*)
  1336. FUNCTION VGA_INSTALLED : BOOLEAN;
  1337.  
  1338. {                                   Returns TRUE if a VGA card is present }
  1339. (*════════════════════════════════════════════════════════════════════════*)
  1340. FUNCTION  WHOAMI : STRING;
  1341.  
  1342. {          S := WHOAMI;               Returns the complete Drive & }
  1343. {                                     Pathname & Filename of the   }
  1344. {       C:\TEST\FILENAME.EXE          program being executed.      }
  1345. (*════════════════════════════════════════════════════════════════════════*)
  1346. PROCEDURE WRITE_DATE(X, Y : INTEGER; WORDS    : CHAR);
  1347.  
  1348. {           WRITE_DATE(X,Y,'W');      Will display the current     }
  1349. {                                     date in words at screen      }
  1350. {                                     location X,Y.                }
  1351. {    If words = 'W'   March 2, 1988                                }
  1352. {    If words = 'D'   Monday April 8, 1991                         }
  1353. {    else             03/02/88                                     }
  1354.  
  1355. {                                     Any character except W or D  }
  1356. {                                     will display it in           }
  1357. {                                     03/02/88 format.             }
  1358. {                                                                  }
  1359. {                                     Also update the Global       }
  1360. {                                     variable DATE to the         }
  1361. {                                     current date.  If X=0        }
  1362. {                                     DATE is updated without      }
  1363. {                                     anything being written       }
  1364. {                                     to the screen.               }
  1365. (*════════════════════════════════════════════════════════════════════════*)
  1366. PROCEDURE WRITE_TIME(X, Y : INTEGER; MILITARY : CHAR);
  1367.  
  1368. {           WRITE_TIME(X,Y,'M');      Will display the current   }
  1369. {                                     time in Military Format    }
  1370. {             14:52                   at screen location  X,Y.   }
  1371. {              2:52 pm                                           }
  1372. {                                     Any Character Except M     }
  1373. {                                     will display time in AM/PM.}
  1374. {                                     The Colon Will Blink.      }
  1375. {                                                                }
  1376. {                                     Also update the Global     }
  1377. {                                     variable TIME to the       }
  1378. {                                     current time.  If X=0      }
  1379. {                                     TIME is updated without    }
  1380. {                                     anything being written     }
  1381. {                                     to the screen.             }
  1382. (*════════════════════════════════════════════════════════════════════════*)
  1383. PROCEDURE WRITE_X80_Y25(CH : CHAR; ATTRIB : INTEGER);
  1384.  
  1385. (*                                     Writes CH at Column 80 on Line 25
  1386.                                        in the Colors of ATTRIB without
  1387.                                        scrolling.                         *)
  1388. (*════════════════════════════════════════════════════════════════════════*)
  1389. FUNCTION _REAL(INSTRING : STRING) : REAL;
  1390.  
  1391. {                                     Returns a REAL value from string.   }
  1392. {                                     Spaces in string are ignored.       }
  1393. (*════════════════════════════════════════════════════════════════════════*)
  1394. FUNCTION _INTEGER(INSTRING : STRING) : INTEGER;
  1395.  
  1396. {                                     Returns an INTEGER value from string.}
  1397. {                                     Spaces in string are ignored.       }
  1398. (*════════════════════════════════════════════════════════════════════════*)
  1399. FUNCTION _LONGINT(INSTRING : STRING) : LONGINT;
  1400.  
  1401. {                                     Returns a LONGINT from a string.     }
  1402. {                                     Spaces in string are ignored.       }
  1403. (*════════════════════════════════════════════════════════════════════════*)
  1404. (*════════════════════════════════════════════════════════════════════════*)
  1405. FUNCTION _WORD(INSTRING : STRING) : WORD;
  1406.  
  1407. {                                     Returns a WORD from a string.       }
  1408. {                                     Spaces in string are ignored.       }
  1409. (*════════════════════════════════════════════════════════════════════════*)