home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / dtx9302 / svga / saver.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-02-18  |  13.6 KB  |  407 lines
  1. (*========================================================*)
  2. (*                     SAVER.PAS v. 1.1                   *)
  3. (*            (C) 1993 Jörg Braun & DMV-Verlag            *)
  4. (* ****************************************************** *)
  5. (*            Demoprogramm für die Unit XGRAPH            *)
  6. (*          Compiler: Turbo Pascal ab Version 5.0         *)
  7. (* ====================================================== *)
  8. (* Benötigt werden:                                       *)
  9. (*  Turbo Pascal ab 5.0, svga.bgi, trip.chr, litt.chr,    *)
  10. (*  die Units xgraph.pas und drivers.pas sowie die Stan-  *)
  11. (*  dard-BGI-Treiber (CGA, EGAVGA ....).                  *)
  12. (*  Treiber und Fonts müssen mit BINOBJ umgewandelt sein. *)
  13. (* »Make« mit: MAKE -fSAVER.MAK                           *)
  14. (* ====================================================== *)
  15. (*      NICHT FÜR BORLAND PASCAL 7.0 PROTECTED-MODE !     *)
  16. (*========================================================*)
  17. {$DEFINE DEBUG}
  18. {$I xgraph.h} {$M 16384, 0, 128000}
  19.  
  20. PROGRAM Non_Resident_Graphics_Screen_Saver;
  21.  
  22. USES
  23.   Dos, Crt, Drivers, XGraph;
  24.  
  25. TYPE
  26.   tSaver = (Logo, Stars, Message, Empty);
  27.  
  28. VAR
  29.   result,
  30.   GraphDriver,
  31.   GraphMode  : INTEGER;
  32.   Help       : BOOLEAN;
  33.   Saver      : tSaver;
  34.  
  35. (*========================================================*)
  36.  
  37. PROCEDURE SmallFontProc;     EXTERNAL; {$L LITT.OBJ}
  38.  
  39. (*========================================================*)
  40.  
  41. PROCEDURE TriplexFontProc;   EXTERNAL; {$L TRIP.OBJ}
  42.  
  43. (*========================================================*)
  44.  
  45. PROCEDURE SaveScreen;
  46. CONST
  47.   msg : STRING[25] = 'Ende mit beliebiger Taste';
  48.   XOld: INTEGER    = 1;
  49.   YOld: INTEGER    = 1;
  50. VAR
  51.   ch        : CHAR;
  52.   MaxX, MaxY: INTEGER;
  53.   p, si     : SHORTINT;
  54.   p1, p2    : POINTER;
  55.   FrameColor,
  56.   PicSize,
  57.   y, BarColor,
  58.   BackColor,
  59.   ShadeColor,
  60.   DOSColor,
  61.   BarStyle,
  62.   BkStyle,
  63.   txColor   : WORD;
  64.   FillInfo  : FillSettingsType;
  65.  
  66.   PROCEDURE BuildLogo;
  67.   CONST
  68.     _Dos_   : STRING[ 3] = 'DOS';
  69.     toolbox : STRING[ 7] = 'toolbox';
  70.     Subtitle: STRING[46] = 'Das Programmierermagazin der '
  71.                          + 'DOS International';
  72.  
  73.   PROCEDURE IBM8514SolidBar(x1, y1, x2, y2: WORD);
  74.   VAR
  75.     i: WORD;
  76.   BEGIN
  77.     FOR i := y1 TO y2 DO Line(x1, i, x2, i);
  78.   END;
  79.  
  80.   PROCEDURE IBM8514LinedBar(x1, y1, x2, y2: WORD);
  81.   VAR
  82.     i: WORD;
  83.     l: LineSettingsType;
  84.   BEGIN
  85.     GetLineSettings(l);
  86.     SetLineStyle(SolidLn, $C3, NormWidth);
  87.     i := y1;
  88.     WHILE i < y2 DO BEGIN
  89.       Line(x1, i, x2, i);
  90.       Inc(i, 2);
  91.     END;
  92.     SetLineStyle(l.LineStyle, l.Pattern, l.Thickness);
  93.   END;
  94.  
  95.   BEGIN
  96.     IF GraphDriver IN [HercMono, EGA, EGA64] THEN
  97.       SetVisualPage(1);
  98.     BkStyle    := SolidFill;   (* bei allen Karten gleich *)
  99.     ShadeColor := Black;
  100.     txColor    := White;
  101.     CASE GraphDriver OF
  102.       CGA, MCGA, ATT400:
  103.       BEGIN
  104.         FrameColor := White;
  105.         BarColor   := Black;
  106.         DOSColor   := White;
  107.         BackColor  := Black;
  108.         BarStyle   := CloseDotFill;
  109.         txColor    := White;
  110.       END;
  111.       EGAMono, HercMono, PC3270:
  112.       BEGIN
  113.         FrameColor := Blue;
  114.         BarColor   := LightGray;
  115.         DOSColor   := LightGray;
  116.         BackColor  := Black;
  117.         BarStyle   := CloseDotFill;
  118.       END;
  119.       EGA, EGA64, VGA, SVGA:
  120.       BEGIN
  121.         FrameColor := LightBlue;
  122.         BarColor   := LightRed;
  123.         DOSColor   := Yellow;
  124.         BackColor  := Blue;
  125.         SetPalette(FrameColor, 63);  (* hellblau --> weiß *)
  126.         BarStyle     := SolidFill;
  127.       END;
  128.       ELSE (* IBM8514 *)
  129.         FrameColor := Cyan;
  130.         BarColor   := Red;
  131.         DOSColor   := Yellow;
  132.         BackColor  := Blue;
  133.         SetColor(BackColor);                 (*Ein Bug in *)
  134.         SetLineStyle(SolidLn, 1, NormWidth); (*ibm8514.bgi*)
  135.         IBM8514LinedBar(101, 91, 289, 149);  
  136.         SetColor(FrameColor);                
  137.         Rectangle(102, 92, 288, 148);
  138.         SetColor(BarColor);                  (*Ein Bug in *)
  139.         IBM8514SolidBar(103, 115, 287, 131); (*ibm8514.bgi*)
  140.     END;
  141.  
  142.     IF GraphDriver <> IBM8514 THEN BEGIN
  143.       SetLineStyle(SolidLn, $3C, ThickWidth);
  144.       SetFillStyle(BkStyle, BackColor);
  145.       Bar(101, 91, 289, 149);
  146.       SetColor(FrameColor);
  147.       Rectangle(102, 92, 288, 148);
  148.       SetFillStyle(BarStyle, BarColor);
  149.       Bar(103, 115, 287, 131)
  150.     END;
  151.  
  152.     (* ======== für alle Grafikkarten identisch: ======== *)
  153.     SetTextStyle(TriplexFont, HorizDir, 5);
  154.     SetColor(ShadeColor);         (* Schriftzug 'toolbox' *)
  155.     FontAttr := Bold;             (* FETT einschalten     *)
  156.     OutTextXY(128,  90, toolbox); (* Schatten  ...        *)
  157.     OutTextXY(129,  91, toolbox); (* doppelt dick         *)
  158.     SetColor(txColor);            (* Vordergrundschrift   *)
  159.     OutTextXY(131,  92, toolbox);
  160.     OutTextXY(132,  91, toolbox); (* ... vierfach dick    *)
  161.     SetTextStyle(TriplexFont, VertDir, 1);(* Kleinschrift *)
  162.     SetColor(ShadeColor);         (* Schriftzug DOS senkr.*)
  163.     OutTextXY(106, 105, _Dos_);   (* Schatten             *)
  164.     SetColor(DOSColor);
  165.     OutTextXY(105, 104, _Dos_);   (* Vordergrund          *)
  166.     SetTextStyle(SmallFont, HorizDir, 1);(* außer Monochr.*)
  167.     FontAttr := Normal;           (* fett ausschalten     *)
  168.     SetColor(txColor);            (* Farbe für den U-Titel*)
  169.     OutTextXY(137, 140, Subtitle);
  170.     SetLineStyle(SolidLn, $3C, NormWidth);
  171.     Line(137, 147, 275, 147);     (* ... unterstrichen    *)
  172.     PicSize := ImageSize(100, 90, 290, 150);(* Bitmapgröße*)
  173.     GetMem(p1, PicSize);          (* Speicher anfordern   *)
  174.     GetImage(100, 90, 290, 150, p1^);(* in Image speichern*)
  175.     SetFillStyle(SolidFill, GetBkColor); (* Bild ...      *)
  176.     Bar(100, 90, 290, 150);       (* schwärzen ...        *)
  177.     GetMem(p2, PicSize);          (* und zweite Bitmap    *)
  178.     GetImage(100, 90, 290, 150, p2^);(* abspeichern       *)
  179.     IF GraphDriver IN [HercMono, EGA, EGA64] THEN
  180.       SetVisualPage(0);
  181.   END;
  182.  
  183.   PROCEDURE DisplayLogo;
  184.   VAR
  185.     x, y : WORD;
  186.   BEGIN
  187.     x := Random(MaxX - 191);  (* x-Position und           *)
  188.     y := Random(MaxY -  61);  (* y-Position = Zufallswert *)
  189.     IF x = 0 THEN x := 190;   (* ... aber > 0             *)
  190.     IF y = 0 THEN y :=  60;
  191.     PutImage(XOld, YOld, p2^, NormalPut);  (* Löschen alt *)
  192.     PutImage(x, y, p1^, NormalPut);        (* Setzen neu  *)
  193.     Delay(Random(1000) + 100);             (* ... warten  *)
  194.     IF Saver = Logo THEN BEGIN
  195.       IF GraphDriver IN [EGA, EGA64, VGA, SVGA] THEN BEGIN
  196.         p := Random(64);              (* Zufallspalette   *)
  197.         IF p MOD 8 = 0 THEN p := 63;  (* Rahmenfarbe per  *)
  198.         SetPalette(FrameColor, p);    (* Palette steuern  *)
  199.     END ELSE IF GraphDriver = IBM8514 THEN
  200.         SetRGBPalette(FrameColor,      (* IBM8514/A nicht *)
  201.                       Random(MaxInt),  (* mit SetPalette  *)
  202.                       Random(MaxInt),  (* sondern RGB-Pa- *)
  203.                       Random(MaxInt)); (* lette           *)
  204.     END ELSE (* IF Saver = Message THEN *) BEGIN
  205.       IF GraphDriver IN [EGA, EGA64, VGA, SVGA] THEN BEGIN
  206.         p := Random(64);              (*    siehe oben    *)
  207.         IF p MOD 8 = 0 THEN p := 63;  
  208.         SetPalette(GetMaxColor, p)    
  209.       END ELSE IF GraphDriver = IBM8514 THEN(* siehe oben *)
  210.         SetRGBPalette(GetMaxColor,    Random(MaxInt),
  211.                       Random(MaxInt), Random(MaxInt)); 
  212.     END;
  213.     XOld := x; YOld := y;             (* Position merken  *)
  214.   END;
  215.  
  216.   PROCEDURE DisplayStars;
  217.   VAR
  218.     x, y: INTEGER;
  219.     c   : WORD;
  220.     v   : INTEGER;
  221.   BEGIN
  222.     x := Random(MaxX);               (* alle Anzeigen per *)
  223.     y := Random(MaxY);               (* Zufallsgenerator  *)
  224.     c := Random(Succ(GetMaxColor));  (* generieren        *)
  225.     v := Random(63);
  226.     IF v MOD 5 = 0 THEN BEGIN
  227.       SetColor(c);
  228.       Circle(x, y, 1);                (* dicker »Punkt«   *)
  229.     END ELSE IF v MOD 32 = 0 THEN BEGIN
  230.       SetColor(c);
  231.       Circle(x, y, 2);
  232.       Line(x, y - 4, x, y + 4);       (* Stern zeichnen   *)
  233.       Line(x + 4, y, x - 4, y);
  234.     END ELSE PutPixel(x, y, c);       (* einfacher Punkt  *)
  235.     (* nicht nur anzeigen, sondern auch wieder schwärzen: *)
  236.     x := Random(MaxX);
  237.     y := Random(MaxY);
  238.     PutPixel(x, y, Black);
  239.     PutPixel(x + 1, y + 1, Black);
  240.     PutPixel(x - 1, y + 1, Black);
  241.     PutPixel(x - 1, y - 1, Black);
  242.     PutPixel(x + 1, y - 1, Black);
  243.     x := Random(x);
  244.     y := Random(y);
  245.     PutPixel(x, y, Black);
  246.     x := Random(x);
  247.     y := Random(y);
  248.     PutPixel(x, y, Black);
  249.     Delay(1);
  250.   END;
  251.  
  252.   PROCEDURE BuildMessage;
  253.   VAR
  254.     i    : BYTE;
  255.     x, x2,
  256.     y, y2: INTEGER;
  257.     Mess : STRING;
  258.     Pal  : PaletteType;
  259.   BEGIN
  260.     Mess := '';
  261.     IF ParamCount > 1 THEN BEGIN
  262.       FOR i := 2 TO ParamCount DO
  263.         Mess := Mess + ParamStr(i) + ' ';
  264.       Delete(Mess, Length(Mess), 1);
  265.     END ELSE Mess := msg;
  266.     IF GraphDriver IN [HercMono, EGA, EGA64] THEN
  267.       SetVisualPage(1);
  268.     x := 150;
  269.     y := 150;
  270.     FontAttr := Outline;
  271.     GetDefaultPalette(Pal);
  272.     SetAllPalette(Pal);
  273.     SetColor(GetMaxColor);
  274.     SetTextStyle(TriplexFont, HorizDir, 2);
  275.     SetTextJustify(LeftText, TopText);
  276.     x2 := TextWidth(Mess)  + x;
  277.     y2 := TextHeight(Mess) + y;
  278.     OutTextXY(x, y, Mess);
  279.     PicSize := ImageSize(x - 5, y - 5, x2 + 5, y2 + 5);
  280.     GetMem(p1, PicSize);
  281.     GetImage(x - 5, y - 5, x2 + 5, y2 + 5, p1^);
  282.     SetColor(GetBkColor);
  283.     OutTextXY(x, y, Mess);
  284.     GetMem(p2, PicSize);
  285.     GetImage(x - 5, y - 5, x2 + 5, y2 + 5, p2^);
  286.     FontAttr := Normal;
  287.     IF GraphDriver IN [HercMono, EGA, EGA64] THEN
  288.       SetVisualPage(0);
  289.   END;
  290.  
  291. BEGIN
  292.   CheckBreak := FALSE;           (* Ctrl-Break abschalten *)
  293.   GraphMode := GetMaxMode; (* max. Auflösung des Treibers *)
  294.   SetBkColor(Black);
  295.   MaxX := GetMaxX;   (* grafikkartenunabhängige Auflösung *)
  296.   MaxY := GetMaxY;
  297.   CASE GraphDriver OF
  298.   EGA, EGA64, VGA, SVGA:
  299.     BEGIN
  300.       SetPalette(Green, 127);      (* Grün <<-->> Weiß    *)
  301.       SetColor(Green);
  302.     END;
  303.   IBM8514:
  304.     BEGIN                          (* 8514/A: RBG-Palette *)
  305.       SetRGBPalette(Green, MaxInt, MaxInt, MaxInt);
  306.       SetColor(Green);
  307.   END ELSE       (* CGA, MCGA, EGAMono, HercMono, PC3270  *)
  308.     SetColor(Succ(GetMaxColor));
  309.   END;
  310.   SetTextStyle(TriplexFont, HorizDir, 2);   (* Info-Text  *)
  311.   FontAttr := Outline;
  312.   OutTextXY(GetMaxX DIV 2 - TextWidth(msg)  DIV 2,
  313.             GetMaxY DIV 2 - TextHeight(msg) DIV 2, msg);
  314.   Delay(1000);                     (* Eine Sekunde warten *)
  315.   SetColor(Black);
  316.   OutTextXY(GetMaxX DIV 2 - TextWidth(msg)  DIV 2,
  317.             GetMaxY DIV 2 - TextHeight(msg) DIV 2, msg);
  318.  
  319.   FontAttr := Normal;
  320.   CASE Saver OF
  321.     Logo   : BuildLogo;
  322.     Message: BuildMessage;
  323.   END;
  324.   Randomize;                       (* Zufallszähler init. *)
  325.   REPEAT                           (* Tasteschleife ...   *)
  326.     CASE Saver OF
  327.       Logo,                        (* Logo anzeigen       *)
  328.       Message: DisplayLogo;        (* Meldung zeigen      *)
  329.       Stars  : DisplayStars;       (* Sterne anzeigen     *)
  330.       ELSE   ;                     (* leerer Bildschirm   *)
  331.     END;
  332.   UNTIL KeyPressed;   (* ... bis beliebige Taste gedrückt *)
  333.   CloseGraph;                    (* Textmodus einschalten *)
  334.   IF Saver IN [Logo, Message] THEN BEGIN
  335.     FreeMem(p1, PicSize);        (* Speicher wieder frei- *)
  336.     FreeMem(p2, PicSize);        (* geben.                *)
  337.   END;
  338.   ch := ReadKey;
  339.   IF ch = #0 THEN ch := ReadKey;(* Tastaturpuffer löschen *)
  340. END;
  341.  
  342. (*========================================================*)
  343.  
  344. PROCEDURE CheckParameters(VAR Help: BOOLEAN);
  345. VAR
  346.   p: STRING;
  347.   b: BYTE;
  348.  
  349. BEGIN
  350.   Help := FALSE;
  351.   IF ParamCount = 0 THEN Saver := Logo ELSE BEGIN
  352.     p := ParamStr(1);            (* ... auswerten         *)
  353.     FOR b := 1 TO Length(p) DO
  354.       p[b] := UpCase(p[b]);
  355.     IF (Pos('?', p) > 0) OR       (* Hilfe  mit /? und /h *)
  356.        (Pos('H', p) > 0) THEN BEGIN
  357.       TextAttr := Yellow;
  358.       WriteLn(^M^J'Screensaver v1.0 (C) 1993 J. Braun & DMV' 
  359.             + 'Verlag');
  360.       TextAttr := LightGray;
  361.       WriteLn('Aufruf: SAVER [[-|/]star|[-|/]black|[-|/]log' 
  362.             + 'o]|[[-|/]mess [Meldung]]|[[-|/]?|h]]   Vorei' 
  363.             + 'nstellung (ohne Parameter) ist das DOS-toolb' 
  364.             + 'ox-Logo.'^M^J'   Das Programm verwendet imme'
  365.             + 'r die höchstmögliche Grafikauflösung.'^J^M);
  366.       Help := TRUE;
  367.     END ELSE
  368.     IF Pos('STAR',  p) > 0 THEN Saver := Stars ELSE
  369.     IF Pos('BLACK', p) > 0 THEN Saver := Empty ELSE
  370.     IF Pos('MESS',  p) > 0 THEN Saver := Message
  371.                            ELSE Saver := Logo;
  372.   END;
  373. END;
  374.  
  375. (*========================================================*)
  376.  
  377. FUNCTION InitGraphics: INTEGER;
  378. VAR
  379.   d : INTEGER;
  380. BEGIN
  381.   d := RegisterBGIFont(@SmallFontProc);
  382.   d := RegisterBGIFont(@TriplexFontProc);
  383.   DetectGraph(GraphDriver, GraphMode);
  384.   IF GraphDriver = HercMono THEN
  385.     IF WORD(Ptr($C000, $0000)^) = $AA55 THEN BEGIN
  386.       GraphDriver := EGAMono;          (* Emulation unter *)
  387.       GraphMode   := EGAMonoHi;        (* OS/2 2.0!       *)
  388.     END;
  389.   InitGraph(GraphDriver, GraphMode, '');
  390.   InitGraphics := GraphResult;
  391. END;
  392.  
  393. (*========================================================*)
  394.  
  395. BEGIN
  396.   CheckParameters(Help);
  397.   IF NOT Help THEN BEGIN
  398.     result := InitGraphics;
  399.     IF result = 0 THEN SaveScreen
  400.     ELSE
  401.       WriteLn('Grafikfehler:'#13#10, GraphErrorMsg(result));
  402.   END;
  403. END.
  404.  
  405. (*========================================================*)
  406. (*                 Ende von SAVER.PAS                     *)
  407.