home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1990 / 05 / tricks / banner.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-02-09  |  5.9 KB  |  205 lines
  1. (* ------------------------------------------------------ *)
  2. (*                     BANNER.PAS                         *)
  3. (*    Programm zur Erstellung von Endlos-Transparenten    *)
  4. (*    aus den BGI-Zeichensätzen                           *)
  5. (*           (c) 1990 Uwe Baumann & TOOLBOX               *)
  6. (* ------------------------------------------------------ *)
  7. PROGRAM Banner;
  8.  
  9. USES Crt, Graph, Printer;
  10.  
  11. TYPE
  12.   PrinterRec = RECORD
  13.                  ModeName   : STRING;
  14.                  InitString : ARRAY [0..6] OF CHAR;
  15.                  DotCode    : CHAR;
  16.                  ExitString : ARRAY [0..6] OF CHAR;
  17.                END;
  18.  
  19.   FontRec    = RECORD
  20.                  FontName  : STRING;
  21.                  MaxSize   : WORD;
  22.                  MaxHeight : BYTE
  23.                END;
  24.  
  25. CONST
  26.   MaxPrinterModes = 2;
  27.   PrinterMode  : ARRAY [1..MaxPrinterModes] OF PrinterRec =
  28.        ((ModeName   : 'Default ASCII';
  29.          InitString : (#0, #0, #0, #0, #0, #0, #0);
  30.          DotCode    : 'X';
  31.          ExitString : (#0, #0, #0, #0, #0, #0, #0) ),
  32.         (ModeName   : 'Epson Esc/P';
  33.          InitString : (#5, #27, 't', #1, #10, #13, #0);
  34.          DotCode    : #219;
  35.          ExitString : (#0, #0, #0, #0, #0, #0, #0)));
  36.  
  37.   MaxFonts = 4;
  38.   Fonts : ARRAY [0..MaxFonts] OF FontRec =
  39.   ((FontName : 'Default';   MaxSize : 9  ; MaxHeight : 72),
  40.    (FontName : 'Triplex';   MaxSize : 7  ; MaxHeight : 71),
  41.    (FontName : 'Small';     MaxSize : 10 ; MaxHeight : 41),
  42.    (FontName : 'SansSerif'; MaxSize : 7  ; MaxHeight : 71),
  43.    (FontName : 'Gothic';    MaxSize : 7  ; MaxHeight : 71));
  44.  
  45. VAR
  46.   GraphDriver, GraphMode, ErrorCode,
  47.   ActFont, ActPrinterMode            : INTEGER;
  48.   OldExitProc                        : POINTER;
  49.   BannerText                         : STRING;
  50.   GraphInitialized                   : BOOLEAN;
  51.  
  52. {$F+}
  53.   PROCEDURE GrExit;
  54.   BEGIN
  55.     ExitProc := OldExitProc;
  56.     CloseGraph;
  57.   END;
  58. {$F-}
  59.  
  60.   PROCEDURE GraphInit;
  61.   BEGIN
  62.     DirectVideo := FALSE;
  63.     OldExitProc := ExitProc;
  64.     ExitProc    := @GrExit;
  65.  
  66.     DetectGraph(GraphDriver, GraphMode);
  67.     GraphDriver := Detect;
  68.  
  69.     InitGraph(GraphDriver, GraphMode, '');
  70.  
  71.     ErrorCode := GraphResult;
  72.     IF ErrorCode <> grOk THEN BEGIN
  73.       WriteLn;
  74.       WriteLn('GRAFIK-INITIALISIERUNGSFEHLER:');
  75.       WriteLn('Fehlercode :', GraphErrorMsg(ErrorCode));
  76.       Halt(1);
  77.     END;
  78.  
  79.     SetColor(GetMaxColor);
  80.     SetFillStyle(SolidFill, 0);
  81.     SetTextJustify(LeftText, TopText);
  82.     GraphInitialized := TRUE;
  83.   END;
  84.  
  85.   PROCEDURE PrintOneChar(OutChar : CHAR);
  86.   VAR
  87.     MagWidth, MagHeight, CountWidth,
  88.     CountHeight, a, b                : INTEGER;
  89.     ChHeight, ChWidth                : WORD;
  90.   BEGIN
  91.     Bar(2, 2, 4 + TextWidth('m'),
  92.         4 + Fonts[ActFont].MaxHeight);
  93.     Bar(3, 8 + Fonts[ActFont].MaxHeight, 3 + TextWidth('m'),
  94.         12 + Fonts[ActFont].MaxHeight);
  95.     OutTextXY(3, 3, OutChar);
  96.  
  97.     FOR CountWidth := 3 TO (3 + TextWidth(OutChar)) DO BEGIN
  98.       FOR CountHeight := (3 + Fonts[ActFont].MaxHeight)
  99.                                                  DOWNTO 3 DO
  100.         IF GetPixel(CountWidth,CountHeight)=GetMaxColor THEN
  101.           Write(LST, PrinterMode[ActPrinterMode].DotCode)
  102.         ELSE Write(LST, ' ');
  103.       WriteLn(LST);
  104.       SetFillStyle(SolidFill, GetMaxColor);
  105.       Bar(3, 8 + Fonts[ActFont].MaxHeight, CountWidth,
  106.           12 + Fonts[ActFont].MaxHeight);
  107.       SetFillStyle(SolidFill, 0);
  108.     END;
  109.   END;
  110.  
  111.   PROCEDURE PrintBanner(Message : STRING);
  112.   VAR
  113.     a  : BYTE;
  114.     ch : CHAR;
  115.   BEGIN
  116.     IF GraphInitialized THEN
  117.       SetGraphMode(GraphMode)
  118.     ELSE
  119.       GraphInit;
  120.  
  121.     SetFillStyle(SolidFill, 0);
  122.     SetTextStyle(ActFont, HorizDir, Fonts[ActFont].MaxSize);
  123.     Rectangle(1, 1, 5 + TextWidth('m'),
  124.               5 + Fonts[ActFont].MaxHeight);
  125.  
  126.     Write(LST, PrinterMode[ActPrinterMode].InitString);
  127.     FOR a := 1 TO Length(Message) DO BEGIN
  128.       PrintOneChar(Message[a]);
  129.       IF KeyPressed THEN BEGIN
  130.         ch := ReadKey;
  131.         IF ch = #27 THEN BEGIN
  132.           RestoreCrtMode;
  133.           Exit;
  134.         END;
  135.       END;
  136.     END;
  137.     Write(LST, PrinterMode[ActPrinterMode].ExitString);
  138.     RestoreCrtMode;
  139.   END;
  140.  
  141.   PROCEDURE InitVars;
  142.   BEGIN
  143.     ActFont          := 0;
  144.     ActPrinterMode   := 1;
  145.     BannerText       := '';
  146.     GraphInitialized := FALSE;
  147.   END;
  148.  
  149.   PROCEDURE Menu;
  150.   VAR
  151.     ch : CHAR;
  152.   BEGIN
  153.     REPEAT
  154.       ClrScr;
  155.       WriteLn('Banner-Druckprogramm 1.0');
  156.       WriteLn('========================');
  157.       WriteLn;
  158.       WriteLn('(c) 1990 Uwe Baumann & TOOLBOX');
  159.       WriteLn;
  160.       WriteLn('Einstellungen:');
  161.       WriteLn('   (1)  Zeichensatz  : ',
  162.                Fonts[ActFont].FontName);
  163.       WriteLn('   (2)  Druckermodus : ',
  164.                PrinterMode[ActPrinterMode].ModeName);
  165.       WriteLn;
  166.       WriteLn('Funktionen:');
  167.       WriteLn('   (3)  Text eingeben / ändern');
  168.       WriteLn('   (4)  Banner drucken (Abbruch mit [Esc])');
  169.       WriteLn('   (5)  Programm beenden');
  170.       WriteLn;
  171.       WriteLn('Banner-Text:');
  172.       WriteLn(BannerText);
  173.       WriteLn;
  174.       Write('Bitte wählen Sie eine Einstellung ',
  175.             'oder Funktion !');
  176.  
  177.       ch := ReadKey;
  178.       CASE ch OF
  179.         '1' : BEGIN
  180.                 Inc(ActFont);
  181.                 IF ActFont > 4 THEN ActFont := 0;
  182.               END;
  183.         '2' : BEGIN
  184.                 Inc(ActPrinterMode);
  185.                 IF ActPrinterMode > MaxPrinterModes THEN
  186.                   ActPrinterMode := 1;
  187.                END;
  188.         '3' : BEGIN
  189.                 GotoXY(1,16);
  190.                 ClrEOL;
  191.                 ReadLn(BannerText);
  192.               END;
  193.         '4' : IF BannerText <> '' THEN
  194.                 PrintBanner(BannerText);
  195.       END;
  196.     UNTIL ch = '5'
  197.   END;
  198.  
  199. BEGIN
  200.   InitVars;
  201.   Menu;
  202. END.
  203. (* ------------------------------------------------------ *)
  204. (*                Ende von BANNER.PAS                     *)
  205.