home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / das_buch / grafik / tewilog0.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-04-18  |  3.4 KB  |  123 lines
  1. {$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,P-,Q-,R-,S-,T-,V-,X-}
  2. {$M 16384,0,655360}
  3. (*===================================================================*)
  4. (*                           TEWILOG0.PAS                            *)
  5. (*                (C) 1993 te-wi Verlag, München                     *)
  6. (*===================================================================*)
  7.  
  8. PROGRAM tewiLogo;
  9.  
  10. USES
  11.   Crt, DOS, Graph, Drivers;
  12.  
  13. VAR
  14.   MaxX, MaxY,
  15.   x, y, gd, gm, i  : INTEGER;
  16.   p1, p2, p3       : Pointer;
  17.   size             : WORD;
  18.   ComplexFont,
  19.   TriplexScriptFont: INTEGER;
  20.   ch               : CHAR;
  21.   Hour, Minute,
  22.   Second, Sec100   : WORD;
  23.  
  24. PROCEDURE SmallFontProc;         EXTERNAL; {$L LITT}
  25. PROCEDURE TriplexScriptFontProc; EXTERNAL; {$L TSCR}
  26. PROCEDURE ComplexFontProc;       EXTERNAL; {$L LCOM}
  27.  
  28. PROCEDURE MoveLogo;
  29. BEGIN
  30.    y := MaxY DIV 2 - 35;
  31.    x := MaxX;
  32.    REPEAT
  33.      IF KeyPressed THEN BEGIN
  34.        PutImage(x, y, p2^, NormalPut);
  35.        Exit;
  36.      END;
  37.      PutImage(x, y, p1^, NormalPut);
  38.      Dec(x, 1)
  39.    UNTIL x <= 1;
  40.    PutImage(x, y, p2^, NormalPut);
  41. END;
  42.  
  43. BEGIN
  44.   CheckBreak := FALSE;
  45.   TriplexScriptFont := RegisterBGIFont(@SmallFontProc);
  46.   ComplexFont := RegisterBGIFont(@ComplexFontProc);
  47.   TriplexScriptFont := RegisterBGIFont(@TriplexScriptFontProc);
  48.   DetectGraph(gd, gm);
  49.   InitGraph(gd, gm, '');
  50.   DirectVideo := TRUE;
  51.   SetTextJustify(LeftText, BottomText);
  52.   SetFillStyle(SolidFill, Cyan);
  53.   SetLineStyle(SolidLn, 0, ThickWidth);
  54.   Bar(2, 2, 218, 68);
  55.   SetColor(Cyan);
  56.   Rectangle(1, 1, 219, 69);
  57.   SetColor(Red);
  58.   Rectangle(4, 4, 216, 66);
  59.   SetTextStyle(TriplexScriptFont, 0, 4);
  60.   x := 10;
  61.   y := 36;
  62.   CASE gd OF
  63.     EGA, VGA, EGA64: SetColor(White);
  64.     ELSE             SetColor(Black);
  65.   END;
  66.   OutTextXY(x + 60, y, 'tewi');
  67.   OutTextXY(x + 61, y, 'tewi');
  68.   SetColor(Black);
  69.   y := y + TextHeight('Pp') DIV 2 + 5;
  70.   SetTextStyle(SmallFont, 0, 4);
  71.   OutTextXY(x + 15, y, 'Die etwas bessere PC-Literatur');
  72.   size := ImageSize(0, 0, 231, 70);
  73.   GetMem(p1, Size);
  74.   GetMem(p2, Size);
  75.   GetMem(p3, Size);
  76.   GetImage(0, 0, 231, 70, p1^);
  77.   SetFillStyle(SolidFill, Black);
  78.   Bar(0, 0, 250, 70);
  79.   GetImage(0, 0, 231, 70, p2^);
  80.   SetFillStyle(SolidFill, Red);
  81.   Bar(2, 2, 218, 68);
  82.   SetColor(LightRed);
  83.   Rectangle(4, 4, 216, 66);
  84.   SetColor(White);
  85.   SetTextStyle(ComplexFont, 0, 3);
  86.   OutTextXY(x + 18, y - 10, 'Falsche Taste');
  87.   GetImage(0, 0, 231, 70, p3^);
  88.   PutImage(0, 0, p2^, NormalPut);
  89.   ch := #0;
  90.   MaxX := GetMaxX;
  91.   MaxY := GetMaxY;
  92.   REPEAT
  93.     GetTime(Hour, Minute, Second, Sec100);
  94.     IF Minute MOD 2 = 0 THEN BEGIN
  95.       Randomize;
  96.       x := Random(MaxX - 221);
  97.       y := Random(MaxY - 71);
  98.       PutImage(x, y, p1^, NormalPut);
  99.       Randomize;
  100.       Delay(Random(1500) + 500);
  101.       PutImage(x, y, p2^, NormalPut);
  102.     END ELSE MoveLogo;
  103.     IF KeyPressed THEN BEGIN
  104.       ch := ReadKey;
  105.       IF ch <> ^F THEN BEGIN
  106.         PutImage(x, y, p3^, NormalPut);
  107.         FOR i := 30 TO 900 DO BEGIN
  108.           Sound(i * 10); Delay(1);
  109.         END;
  110.         FOR i := 900 DOWNTO 30 DO BEGIN
  111.           Sound(i * 10); Delay(1);
  112.         END;
  113.         NoSound;
  114.         PutImage(x, y, p2^, NormalPut);
  115.       END;
  116.     END;
  117.   UNTIL ch = ^F;
  118.   FreeMem(p1, Size);
  119.   FreeMem(p2, Size);
  120.   CloseGraph;
  121. END.
  122.  
  123. (*===================================================================*)