home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / spezial / 14 / big / bigtext.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1988-10-07  |  2.9 KB  |  101 lines
  1. (* ------------------------------------------------------ *)
  2. (*                    BIGTEXT.PAS                         *)
  3. (*     Unit zur Ausgabe von Texten in Großschrift         *)
  4. (*          (c) 1988 by Erhard Ernst & TOOLBOX            *)
  5. (* ------------------------------------------------------ *)
  6.  
  7. UNIT BigText;
  8.  
  9. INTERFACE
  10.  
  11. USES CRT;
  12.  
  13. TYPE  string10 = STRING[10];
  14.  
  15. CONST WriteBig_installiert: BOOLEAN = FALSE;
  16.  
  17. VAR   WriteBig_Font       : array[#0..#255,0..7] of byte;
  18.       WriteBig_Char       :     char;
  19.       WriteBig_NoChar     :   char;
  20.  
  21. PROCEDURE WriteBig_Init;
  22.  
  23. PROCEDURE WriteBig_Reset;
  24.  
  25. PROCEDURE WriteBig(x,y: BYTE; Zeile: string10;
  26.                    Ueberschreiben  : BOOLEAN);
  27.  
  28. FUNCTION  GRAFTABL_geladen: BOOLEAN;
  29.  
  30.  
  31. IMPLEMENTATION
  32.  
  33. (* ------------------------------------------------------ *)
  34. FUNCTION  GRAFTABL_geladen: BOOLEAN;
  35.  
  36. VAR RAM_Seg: INTEGER ABSOLUTE $0000:$007E;
  37.     RAM_Ofs: INTEGER ABSOLUTE $0000:$007C;
  38.  
  39. BEGIN
  40.   Graftabl_geladen := (RAM_Seg >= 0) AND (RAM_Ofs >= 0);
  41. END;
  42. (* ------------------------------------------------------ *)
  43. PROCEDURE WriteBig_init;
  44.  
  45. VAR RAM_Seg: INTEGER ABSOLUTE $0000:$007E;
  46.     RAM_Ofs: INTEGER ABSOLUTE $0000:$007C;
  47.  
  48. BEGIN
  49.   FillChar(WriteBig_Font,$800,#0);
  50.                                  (* 1. ROM-Font einlesen: *)
  51.   Move(Mem[$F000:$FA6E],
  52.        Mem[Seg(WriteBig_Font): Ofs(WriteBig_Font)], $400);
  53.                                  (* 2. RAM-Font einlesen: *)
  54.   IF Graftabl_geladen THEN
  55.     Move(Mem[RAM_Seg:RAM_Ofs], Mem[seg(WriteBig_Font):
  56.         (Ofs(WriteBig_Font) + $400)], $400);
  57.   WriteBig_Char  := #219;
  58.   WriteBig_NoChar:=  #32;
  59.   WriteBig_installiert := TRUE;
  60. END;
  61. (* ------------------------------------------------------ *)
  62. PROCEDURE WriteBig_Reset;
  63. BEGIN
  64.   WriteBig_installiert := FALSE;
  65. END;
  66. (* ------------------------------------------------------ *)
  67. PROCEDURE WriteBig(x,y: BYTE; zeile: string10;
  68.                    Ueberschreiben  : BOOLEAN);
  69. VAR i, Spalte: BYTE;
  70.  
  71.   PROCEDURE Ausgeben(x,y: BYTE; Zeichen: CHAR);
  72.   VAR row, col, m, Maske: BYTE;
  73.   BEGIN
  74.     IF (x < 74) AND (y < 19) THEN
  75.       FOR row := 0 TO 7 DO BEGIN
  76.         Maske := WriteBig_Font[Zeichen, row];
  77.         FOR col := 0 TO 7 DO BEGIN
  78.           GotoXY(x + col, y + row);
  79.           m := 128 SHR col;
  80.           IF (Maske AND m) = m THEN write(WriteBig_Char)
  81.           ELSE IF Ueberschreiben THEN
  82.             write(WriteBig_NoChar);
  83.         END;
  84.       END;
  85.   END;
  86.  
  87. BEGIN
  88.   IF NOT WriteBig_installiert THEN WriteBig_init;
  89.   IF x = 0 THEN x := WhereX;
  90.   IF y = 0 THEN y := WhereY;
  91.   FOR i := 1 TO length(Zeile) DO
  92.     Ausgeben(x + (i - 1) * 8, y, Zeile[i]);
  93. END;
  94. (* ------------------------------------------------------ *)
  95.  
  96. BEGIN
  97.   WriteBig_Init;
  98. END.
  99. (* ------------------------------------------------------ *)
  100. (*               Ende von BIGTEXT.PAS                     *)
  101.