home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / dtx9302 / svga / ega320.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-02-17  |  4.2 KB  |  114 lines

  1. (*========================================================*)
  2. (*                         EGA320.PAS                     *)
  3. (*========================================================*)
  4. (*             (C) 1993 Jörg Braun & DMV-Verlag           *)
  5. (*  Das Programm demonstriert die EGA 320x200/16-Farben-  *)
  6. (*             grafik mit dem Treiber SVGA.BGI            *)
  7. (*             Compiler: Turbo Pascal ab V. 5.0           *)
  8. (*              »MAKE« mit: MAKE -fEGA320.MAK             *)
  9. (*========================================================*)
  10. {$I xgraph.h} {$M 16384,0,655360}
  11.  
  12. PROGRAM TestEGA320;
  13.  
  14. USES
  15.   DOS, Crt, XGraph;
  16.  
  17. VAR
  18.  gd, gm  : INTEGER;
  19.  i, f, l : WORD;
  20.  gr      : INTEGER;
  21.  xOld,
  22.  yOld,
  23.  d,
  24.  x, y, c : INTEGER;
  25.  p,
  26.  PicSize : WORD;
  27.  p1, p2  : Pointer;
  28.  ch      : CHAR;
  29.  
  30. PROCEDURE SmallFontProc;     EXTERNAL; {$L LITT.OBJ}
  31. PROCEDURE TriplexFontProc;   EXTERNAL; {$L TRIP.OBJ}
  32.  
  33. CONST
  34.   _Dos_   : STRING[3] = 'DOS';
  35.   toolbox : STRING[9] = 'toolbox';
  36.   Subtitle: STRING[46]= 'Das Programmierermagazin der ' +
  37.                         'DOS International';
  38. BEGIN
  39.   gd := EGA;
  40.   gm := EGA320;
  41.   InitGraph(gd, gm, GetEnv('BGIPATH'));
  42.   IF BYTE(Ptr($40, $49)^) <> $0D THEN
  43.     WriteLn('Initialisierungsfehler:'#13#10,
  44.             GraphErrorMsg(-11))
  45.   ELSE BEGIN
  46.     d := RegisterBGIFont(@SmallFontProc);  (* Fonts laden *)
  47.     d := RegisterBGIFont(@TriplexFontProc);
  48.     CheckBreak := FALSE;         (* Ctrl-Break abschalten *)
  49.     Randomize;
  50.     SetVisualPage(1);
  51.     SetActivePage(0);
  52.     SetLineStyle(SolidLn, 1, NormWidth);
  53.     SetFillStyle(SolidFill, Blue);
  54.     Bar(101, 91, 289, 149);
  55.     SetColor(LightBlue);
  56.     Rectangle(101, 91, 289, 149);
  57.     SetFillStyle(SolidFill, LightRed);
  58.     Bar(103, 115, 287, 131);
  59.     SetTextJustify(LeftText, TopText);
  60.     FontAttr := Bold;               (* FETT einschalten   *)
  61.     SetTextStyle(TriplexFont, HorizDir, 5);
  62.     SetColor(Black);                (* Schrift 'toolbox'  *)
  63.     OutTextXY(128,  90, toolbox);   (* Schatten  ...      *)
  64.     OutTextXY(129,  91, toolbox);   (* doppelt dick       *)
  65.     SetColor(White);                (* Vordergrundschrift *)
  66.     OutTextXY(131,  92, toolbox);
  67.     OutTextXY(132,  91, toolbox); (* ... vierfach dick    *)
  68.  
  69.     SetTextStyle(TriplexFont, VertDir, 1);(* kleine Schr. *)
  70.     SetColor(Black);              (* Schriftzug DOS senkr.*)
  71.     OutTextXY(106, 105, _Dos_);   (* Schatten             *)
  72.     SetColor(Yellow);
  73.     OutTextXY(105, 104, _Dos_);   (* Vordergrund          *)
  74.  
  75.     SetTextStyle(SmallFont, HorizDir, 1);
  76.     FontAttr := Normal;           (* FETT ausschalten     *)
  77.     SetColor(White);              (* Farbe für den U-Titel*)
  78.     OutTextXY(137, 135, Subtitle);
  79.     Line(137, 142, 275, 142);       (* ... unterstrichen  *)
  80.  
  81.     PicSize := ImageSize(100, 90, 290, 150); (* Bitmapgr. *)
  82.     GetMem(p1, PicSize);            (* Speicher anfordern *)
  83.     GetImage(100, 90, 290, 150, p1^); (* in Image speich. *)
  84.     SetFillStyle(SolidFill, GetBkColor); (* Bild ...      *)
  85.     Bar(100, 90, 290, 150);         (* schwärzen ...      *)
  86.     GetMem(p2, PicSize);            (* und zweite Bitmap  *)
  87.     GetImage(100, 90, 290, 150, p2^); (* abspeichern      *)
  88.     ClearDevice;
  89.     SetActivePage(0);
  90.     SetVisualPage(0);
  91.     REPEAT
  92.       x := Random(140);       (* x-Position und           *)
  93.       y := Random(140);       (* y-Position = Zufallswert *)
  94.       IF x = 0 THEN x := 100;
  95.       IF y = 0 THEN y := 100;
  96.       PutImage(XOld, YOld, p2^, NormalPut);(* Löschen alt *)
  97.       PutImage(x, y, p1^, NormalPut);      (* Setzen neu  *)
  98.       Delay(Random(1000) + 100);           (* ... warten  *)
  99.       p := Random(128);               (* Zufallspalette   *)
  100.       IF p MOD 8 = 0 THEN p := 63;    (* Rahmenfarbe per  *)
  101.       SetPalette(LightBlue, p);       (* Palette steuern  *)
  102.       XOld := x; YOld := y;           (* Position merken  *)
  103.     UNTIL KeyPressed;
  104.     ch := ReadKey;
  105.     IF ch = #0 THEN ch := Readkey;
  106.     CloseGraph;
  107.     FreeMem(p1, PicSize);        (* Speicher wieder frei- *)
  108.     FreeMem(p2, PicSize);        (* geben.                *)
  109.   END;
  110. END.
  111.  
  112. (*--------------------------------------------------------*)
  113. (*                  Ende von EGA320.PAS                   *)
  114.