home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / TSPA2555.ZIP / TSUNTE.TST < prev    next >
Encoding:
Text File  |  1990-07-22  |  4.0 KB  |  160 lines
  1. (* This is a test program for the TSUNTE.TPU unit
  2.    19-Aug-89, Updated 24-Sep-89, 8-Oct-89, 4-Nov-89, 4-Dec-89, 17-Jul-90 *)
  3.  
  4. uses Dos, TSUNTE;
  5.  
  6. procedure LOGO;
  7. begin
  8.   writeln;
  9.   writeln ('TSUNTE unit test by Prof. Timo Salmi, 22-Jul-90');
  10.   writeln ('University of Vaasa, Finland, ts@chyde.uwasa.fi');
  11.   writeln;
  12. end;  (* logo *)
  13.  
  14. (* Testing the cursor routines *)
  15. procedure TEST1;
  16. begin
  17.   CURSOFF;
  18.   writeln ('Cursor is off, press <═╝');
  19.   CLB;
  20.   readln;
  21.   CURSON;
  22.   writeln ('Cursor is on, press <═╝');
  23.   CLB;
  24.   readln;
  25.   CURSOR (0, 13);
  26.   writeln ('Cursor is big, press <═╝');
  27.   CLB;
  28.   readln;
  29.   CURSOR (6, 7);
  30.   writeln ('Cursor is normal, press <═╝');
  31.   CLB;
  32.   readln;
  33. end;  (* test1 *)
  34.  
  35. (* The most common system clock weekday *)
  36. procedure TEST2;
  37. const wkday : string[21] = 'SunMonTueWedThuFriSat';
  38. begin
  39.   writeln ('25-7-1980 was ', Copy (wkday, 3*WKDAYFN(25,7,1980)+1, 3));
  40.   writeln ('Week number ', WEEKNRFN (25,7,1980,false));
  41. end;  (* test2 *)
  42.  
  43. (* Special key status *)
  44. procedure TEST5;
  45. begin
  46.   if CAPSONFN then writeln ('CapsLock on') else writeln ('CapsLock off');
  47.   if NUMLONFN then writeln ('NumLock on') else writeln ('NumLock off');
  48.   if SCRLONFN then writeln ('ScrollLock on') else writeln ('ScrollLock off');
  49. end;  (* test5 *)
  50.  
  51. (* Existence and size of a file
  52.    IMPORTANT: Never apply on an open file! *)
  53. procedure TEST6;
  54. var fname : string;
  55. begin
  56.   fname := 'a:\command.com';          {Alter fname as appropriate}
  57.   if FEXISTFN (fname) then            {**************************}
  58.      begin
  59.        writeln ('File ', fname, ' size ', FSIZEFN(fname), ' bytes');
  60. {$IFNDEF VER40}
  61.        writeln ('The allocated size is ', ALLSIZFN(fname), ' bytes');
  62. {$ENDIF}
  63.      end
  64.    else
  65.      writeln ('File ', fname, ' does not exist');
  66. end;  (* test6 *)
  67.  
  68. (* Get the entire command line, spaces and all *)
  69. procedure TEST7;
  70. begin
  71.   writeln;
  72.   writeln ('Command line = ', CMDLNFN);
  73.   writeln;
  74. end;  (* test7 *)
  75.  
  76. (* Demonstrate keyboard status, observe your keyboard status leds *)
  77. procedure TEST8;
  78. const loop = 100000;  { adjust to your PC speed if necessary }
  79. var i, j : longint;
  80. begin
  81.   for j := 1 to 10 do
  82.     begin
  83.       CAPS (true);
  84.       NUMLOCK (false);
  85.       SCRLOCK (true);
  86.       if j = 1 then TEST5;
  87.       for i := 1 to loop do;
  88.       CAPS (false);
  89.       NUMLOCK (true);
  90.       SCRLOCK (false);
  91.       for i := 1 to loop do;
  92.     end;
  93.   TEST5;
  94. end;  (* test8 *)
  95.  
  96. (* The number of days in a given month and year *)
  97. procedure TEST9;
  98. var month, year : word;
  99. begin
  100.   month := 7;
  101.   year  := 1990;
  102.   writeln ('The last day of ', month, '-', year, ' is ',
  103.             LASTDMFN (month, year));
  104.   Flush (output);
  105.   month := 2;
  106.   year := 1988;
  107.   writeln ('The last day of ', month, '-', year, ' is ',
  108.             LASTDMFN (month, year));
  109.   Flush (output);
  110. end;  (* test9 *)
  111.  
  112. (* Test the validity of a date *)
  113. procedure TEST10;
  114. var day, month, year : word;
  115. begin
  116.   day   := 22;
  117.   month := 7;
  118.   year  := 1990;
  119.   write ('Date ', day, '-', month, '-', year);
  120.   if DATEOKFN (day, month, year) then
  121.      writeln (' is valid')
  122.    else
  123.      writeln (' is NOT valid');
  124. end;  (* test10 *)
  125.  
  126. (* Test which date is earlier *)
  127. procedure TEST11;
  128. var day, month, year                 : word;
  129.     daynow, monthnow, yearnow, dummy : word;
  130.     z, znow                          : real;
  131. begin
  132.   GetDate (yearnow, monthnow, daynow, dummy);
  133.   day   := 22;
  134.   month := 7;
  135.   year  := 1990;
  136.   write ('Date ', day, '-', month, '-', year);
  137.   z    := ZELLERFN (day, month, year);
  138.   znow := ZELLERFN (daynow, monthnow, yearnow);
  139.   if z = znow then
  140.      writeln (' is today')
  141.    else if z < znow then
  142.      writeln (' is earlier than today')
  143.    else
  144.      writeln (' is later than today');
  145. end;  (* test11 *)
  146.  
  147. (* Main program *)
  148. begin
  149.   LOGO;
  150.   BORDER(5);
  151.   TEST7;
  152.   TEST1;
  153.   TEST2;
  154.   TEST5;
  155.   TEST6;
  156.   write ('Press <═╝'); readln;
  157.   BORDER(0);
  158.   { If you want the rest of the test, insert the calls }
  159. end.  (* tsunte.tst *)
  160.