home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / spezial / 14 / big / bigdemo.pas next >
Encoding:
Pascal/Delphi Source File  |  1988-10-07  |  4.7 KB  |  159 lines
  1. (* ------------------------------------------------------ *)
  2. (*                   BIGDEMO.PAS                          *)
  3. (*         Demonstration zur Unit BIGTEXT.PAS             *)
  4. (*         (c) 1988 by Erhard Ernst & TOOLBOX             *)
  5. (* ------------------------------------------------------ *)
  6. PROGRAM BigText_Demo;
  7.  
  8. USES Crt, BigText;
  9.  
  10. (* ------------------------------------------------------ *)
  11. PROCEDURE Wait(Sekunden: REAL);
  12. VAR DOS_Timer: INTEGER ABSOLUTE $0040:$006C;
  13.     ticks    : INTEGER;
  14.     tc, stop : REAL;
  15.  
  16. BEGIN
  17.   stop := 18.2 * Sekunden;            { 18.2 Ticks/Sekunde }
  18.   tc := 0;
  19.   REPEAT
  20.     ticks := Dos_Timer;               { Uhr "stellen"      }
  21.     REPEAT UNTIL Dos_Timer <> ticks;  { auf Ticken warten  }
  22.     tc := tc + 1;
  23.   UNTIL tc >= stop;                   { "Zeitvergleich"    }
  24. END;
  25.  
  26. (* ------------------------------------------------------ *)
  27. PROCEDURE NextPage(sek: INTEGER);
  28. BEGIN
  29.   GotoXY(80,25); Wait(sek); ClrScr;
  30. END;
  31.  
  32. (* ------------------------------------------------------ *)
  33. (* Schaltet Tastatur-Sperre EIN/AUS: mit Vorsicht zu      *)
  34. (* genießen, da die Sperre auch nach Programmende oder    *)
  35. (* -abbruch aktiv bleibt! Die Sperre ist nur durch einen  *)
  36. (* Hardware-Reset zu deaktivieren.                        *)
  37.  
  38. PROCEDURE Kbd_Lock(sperren: BOOLEAN);
  39. VAR status: BYTE;
  40.  
  41. BEGIN
  42.   status := port[97];
  43.   IF sperren THEN
  44.     portw[97] := status OR  128               { Bit 7 := 1 }
  45.   ELSE
  46.     portw[97] := status AND 127;              { Bit 7 := 0 }
  47. END;
  48.  
  49. (* ------------------ Demo-Programm --------------------- *)
  50.  
  51. TYPE string80 = STRING[80];
  52. VAR  i, j     : BYTE;
  53.  
  54.  
  55. PROCEDURE Center(y: BYTE; s: string80);
  56. VAR x: BYTE;
  57.  
  58. BEGIN
  59.   x := 41 - (Length(s) DIV 2); GotoXY(x,y); Write(s);
  60. END;
  61.  
  62. (* ------------------------------------------------------ *)
  63. PROCEDURE Neue_Zeichen;
  64. CONST Font: ARRAY[0..4, 0..7] OF BYTE =
  65.                                ((0,252,230,252,230,252,0,0),
  66.                                 (0,224,224,224,224,254,0,0),
  67.                                 (0,56,100,226,116,56,0,0),
  68.                                 (254,56,56,56,56,56,56,56),
  69.                                 (0,198,108,56,108,198,0,0));
  70.       Bu  : ARRAY[0..4] OF CHAR = ('B','L','O','T','X');
  71. BEGIN
  72.   WriteBig_Char   := #32;              { Das liefert       }
  73.   WriteBig_NoChar := #219;             { "inverse" Schrift }
  74.   WriteBig(1, 1,'╔════════╗', TRUE);
  75.   WriteBig(1, 9,'║        ║', TRUE);
  76.   WriteBig(1,17,'╚════════╝', TRUE);
  77.   FOR i := 0 TO 4 DO
  78.     Move(Font[i,0], WriteBig_Font[Bu[i],0],8);
  79.   WriteBig(14,9,'TOOLBOX', TRUE);
  80.   Center(16, ' Demo für selbstdefinierte Zeichen ');
  81.   NextPage(15);
  82.   END;
  83.  
  84. (* ------------------------------------------------------ *)
  85. PROCEDURE Titelbild;
  86.  
  87. BEGIN
  88.   WriteBig_NoChar := #176;
  89.   WriteBig(1,1,'          ',true);
  90.   WriteBig(1,9,'          ',true);
  91.   center(14,' (c) 1988 by E. Ernst & TOOLBOX ');
  92.   IF GrafTabl_geladen THEN
  93.     Center(21,'GRAFTABL ist geladen.')
  94.   ELSE BEGIN
  95.     Center(21,'GRAFTABL ist nicht geladen!');
  96.     Center(22,
  97.  'Die Zeichen [#128..#255] werden als Blanks dargestellt.');
  98.   END;
  99.   Center(25,
  100.      'Ihre Tastatur ist für die Dauer der Demo gesperrt !');
  101.   FOR i := 0 TO 4 DO BEGIN
  102.     WriteBig_Char := chr(223 - i);
  103.     WriteBig(1,5,' WriteBig ',true);
  104.     Wait(2);
  105.   END;
  106.   NextPage(10);
  107. END;
  108.  
  109. (* ------------------------------------------------------ *)
  110. PROCEDURE Uhr;
  111. VAR s: STRING[2];
  112.  
  113. BEGIN
  114.   WriteBig(9,2,'Uhr-Demo',TRUE);
  115.   WriteBig(8,14,'12:34:', TRUE);
  116.   i := 30;
  117.   REPEAT
  118.     Str(i:2,s); WriteBig(56,14,s,TRUE); Wait(1); i := i + 1;
  119.   UNTIL i > 56;
  120.   NextPage(5);
  121. END;
  122.  
  123. (* ------------------------------------------------------ *)
  124. PROCEDURE Zeichensatz;
  125. VAR k: BYTE;
  126.  
  127. BEGIN
  128.   WriteBig_NoChar := #250; WriteBig_Char := #219;
  129.   WriteBig(1, 1,'DER       ',TRUE);
  130.   WriteBig(1, 9,'GELADENE  ',TRUE);
  131.   WriteBig(1,17,'ASCII-SATZ',TRUE);
  132.   IF Graftabl_geladen THEN k := 31 ELSE k := 15;
  133.   FOR i := 0 TO k DO BEGIN
  134.     IF (i MOD 3 = 0) THEN NextPage(5);
  135.   WriteBig_Char := Chr((i MOD 3) + 176);
  136.   GotoXY(1, 1 + (i MOD 3) * 8);
  137.   Write('#',i*8,'...');
  138.   FOR j := 0 TO 7 DO
  139.     WriteBig(10 + j*9, 1 + (i MOD 3)*8, Chr(i*8 + j), TRUE);
  140.   END;
  141. END;
  142.  
  143.  
  144. (* ------------------------------------------------------ *)
  145. BEGIN
  146.   ClrScr;
  147.   HighVideo;
  148.   Kbd_Lock(TRUE);                       { Tastatur sperren }
  149.   WriteBig_Init; Titelbild;
  150.   WriteBig_Init; Neue_Zeichen;
  151.   WriteBig_Init; Uhr;
  152.   WriteBig_Init; Zeichensatz;
  153.   WriteBig_Reset;
  154.   Kbd_Lock(false);               { Tastatursperre aufheben }
  155. END.
  156.  
  157. (* ------------------------------------------------------ *)
  158. (*                Ende von BIGDEMO.PAS                    *)
  159.