home *** CD-ROM | disk | FTP | other *** search
- (*========================================================*)
- (* EGA320.PAS *)
- (*========================================================*)
- (* (C) 1993 Jörg Braun & DMV-Verlag *)
- (* Das Programm demonstriert die EGA 320x200/16-Farben- *)
- (* grafik mit dem Treiber SVGA.BGI *)
- (* Compiler: Turbo Pascal ab V. 5.0 *)
- (* »MAKE« mit: MAKE -fEGA320.MAK *)
- (*========================================================*)
- {$I xgraph.h} {$M 16384,0,655360}
-
- PROGRAM TestEGA320;
-
- USES
- DOS, Crt, XGraph;
-
- VAR
- gd, gm : INTEGER;
- i, f, l : WORD;
- gr : INTEGER;
- xOld,
- yOld,
- d,
- x, y, c : INTEGER;
- p,
- PicSize : WORD;
- p1, p2 : Pointer;
- ch : CHAR;
-
- PROCEDURE SmallFontProc; EXTERNAL; {$L LITT.OBJ}
- PROCEDURE TriplexFontProc; EXTERNAL; {$L TRIP.OBJ}
-
- CONST
- _Dos_ : STRING[3] = 'DOS';
- toolbox : STRING[9] = 'toolbox';
- Subtitle: STRING[46]= 'Das Programmierermagazin der ' +
- 'DOS International';
- BEGIN
- gd := EGA;
- gm := EGA320;
- InitGraph(gd, gm, GetEnv('BGIPATH'));
- IF BYTE(Ptr($40, $49)^) <> $0D THEN
- WriteLn('Initialisierungsfehler:'#13#10,
- GraphErrorMsg(-11))
- ELSE BEGIN
- d := RegisterBGIFont(@SmallFontProc); (* Fonts laden *)
- d := RegisterBGIFont(@TriplexFontProc);
- CheckBreak := FALSE; (* Ctrl-Break abschalten *)
- Randomize;
- SetVisualPage(1);
- SetActivePage(0);
- SetLineStyle(SolidLn, 1, NormWidth);
- SetFillStyle(SolidFill, Blue);
- Bar(101, 91, 289, 149);
- SetColor(LightBlue);
- Rectangle(101, 91, 289, 149);
- SetFillStyle(SolidFill, LightRed);
- Bar(103, 115, 287, 131);
- SetTextJustify(LeftText, TopText);
- FontAttr := Bold; (* FETT einschalten *)
- SetTextStyle(TriplexFont, HorizDir, 5);
- SetColor(Black); (* Schrift 'toolbox' *)
- OutTextXY(128, 90, toolbox); (* Schatten ... *)
- OutTextXY(129, 91, toolbox); (* doppelt dick *)
- SetColor(White); (* Vordergrundschrift *)
- OutTextXY(131, 92, toolbox);
- OutTextXY(132, 91, toolbox); (* ... vierfach dick *)
-
- SetTextStyle(TriplexFont, VertDir, 1);(* kleine Schr. *)
- SetColor(Black); (* Schriftzug DOS senkr.*)
- OutTextXY(106, 105, _Dos_); (* Schatten *)
- SetColor(Yellow);
- OutTextXY(105, 104, _Dos_); (* Vordergrund *)
-
- SetTextStyle(SmallFont, HorizDir, 1);
- FontAttr := Normal; (* FETT ausschalten *)
- SetColor(White); (* Farbe für den U-Titel*)
- OutTextXY(137, 135, Subtitle);
- Line(137, 142, 275, 142); (* ... unterstrichen *)
-
- PicSize := ImageSize(100, 90, 290, 150); (* Bitmapgr. *)
- GetMem(p1, PicSize); (* Speicher anfordern *)
- GetImage(100, 90, 290, 150, p1^); (* in Image speich. *)
- SetFillStyle(SolidFill, GetBkColor); (* Bild ... *)
- Bar(100, 90, 290, 150); (* schwärzen ... *)
- GetMem(p2, PicSize); (* und zweite Bitmap *)
- GetImage(100, 90, 290, 150, p2^); (* abspeichern *)
- ClearDevice;
- SetActivePage(0);
- SetVisualPage(0);
- REPEAT
- x := Random(140); (* x-Position und *)
- y := Random(140); (* y-Position = Zufallswert *)
- IF x = 0 THEN x := 100;
- IF y = 0 THEN y := 100;
- PutImage(XOld, YOld, p2^, NormalPut);(* Löschen alt *)
- PutImage(x, y, p1^, NormalPut); (* Setzen neu *)
- Delay(Random(1000) + 100); (* ... warten *)
- p := Random(128); (* Zufallspalette *)
- IF p MOD 8 = 0 THEN p := 63; (* Rahmenfarbe per *)
- SetPalette(LightBlue, p); (* Palette steuern *)
- XOld := x; YOld := y; (* Position merken *)
- UNTIL KeyPressed;
- ch := ReadKey;
- IF ch = #0 THEN ch := Readkey;
- CloseGraph;
- FreeMem(p1, PicSize); (* Speicher wieder frei- *)
- FreeMem(p2, PicSize); (* geben. *)
- END;
- END.
-
- (*--------------------------------------------------------*)
- (* Ende von EGA320.PAS *)
-