Power-Programmierung/CD1.mdf/pascal/das_buch/grafik/vga256.pas

Pascal/Delphi Source File | 1993-05-09 | 5.6 KB | 167 lines

{$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,P-,Q-,R-,S-,T-,V-,X-}
{$M 16384,0,655360}
(*===================================================================*)
(*                               VGA256.PAS                          *)
(*                         (C) 1993 te-wi Verlag                     *)
(*-------------------------------------------------------------------*)
(* Demo- und Testprogramm für den Grafiktreiber VGA256 und Grafik    *)
(* in 320*200 Punkten und 256 Farben.                                *)
(*===================================================================*)

PROGRAM VGA256Color;

USES
  Crt, Graph, GraphErg;

CONST
  VGA256Lo = 0;
  DriverID : STRING[8] = 'VGA256';

VAR
  SVGADriverPtr    : Pointer;
  gd, gm, result,
  f, CtrX, CtrY,
  corr1, corr2,
  x1, x2, XMax, xr, xl,
  MaxX, MaxY, i, j,
  EuropeanFont     : INTEGER;
  ch               : CHAR;
  s                : STRING;
BEGIN
  ClrScr;
  TextAttr := Yellow;
  GotoXY(33, 2); WriteLn('==============');
  GotoXY(33, 3); WriteLn('Test - VGA-256');
  GotoXY(33, 4); WriteLn('==============');
  TextAttr := White;
  GotoXY(15, 7);
  WriteLn('Achtung: Dieses Programm läuft nicht auf jeder Hard-');
  WriteLn('w': 15, 'are! Es benötigt außerdem im aktuellen Verzeichnis');
  WriteLn('d': 15, 'ie Dateien ', DriverID,'.BGI, EURO.CHR und LITT.CHR.'#10);
  WriteLn('S': 15, 'ie können nun das Programm noch mit [ESC] abbrechen -');
  Write  ('a': 15, 'nsonsten drücken Sie bitte eine beliebige Taste. ');
  ch := #0;
  REPEAT
    ch := Readkey;
  UNTIL ch <> #0;
  IF ch = #27 THEN Halt;
  DetectGraph(gd, gm);
  IF gd <> VGA THEN
  BEGIN
    ClrScr;
    WriteLn('Ich habe keine VGA-Karte gefunden, also wird das Programm');
    WriteLn('auf keinen Fall unterstützt.');
    WriteLn('Testprogramm wird abgebrochen!');
    Halt;
  END;
  IF ParamCount > 0 THEN DriverID := ParamStr(1);
  FOR i := 1 TO LENGTH(DriverID) DO DriverID[i] := UpCase(DriverID[i]);
  IF DriverID = 'EGAVGA' THEN gm := VGAHi
                         ELSE gm := VGA256Lo;
  gd := InstallUserDriver(DriverID, SVGADriverPtr);
  EuropeanFont := InstallUserFont('EURO');
  InitGraph(gd, gm, '');
  CheckSnow := FALSE;
  DirectVideo := TRUE;
  result := GraphResult;
  IF result < 0 THEN BEGIN
    WriteLn(^G, GraphErrorMsg(result));
    Halt;
  END;
  MaxX := GetMaxX + 1; CtrX := MaxX DIV 2;
  MaxY := GetMaxY + 1; CtrY := MaxY DIV 2;
  SetFillStyle(SolidFill, DarkGray);
  Bar(0, 0, MaxX, MaxY);
  SetBkColor(Black);
  SetFillStyle(SolidFill, Red);
  Bar(CtrX DIV 4, 0, MaxX - CtrX DIV 4, CtrY * 2 - 1);
  IF MaxX > 320 THEN
    SetLineStyle(SolidLn, 0, ThickWidth);
  Circle(CtrX, CtrY, CtrY);
  SetFillStyle(XHatchFill, LightBlue);
  PieSlice(CtrX, CtrY, 0, 90, CtrY);
  SetFillStyle(HatchFill, LightBlue);
  PieSlice(CtrX, CtrY, 90, 180, CtrY);
  SetFillStyle(CloseDotFill, LightCyan);
  PieSlice(CtrX, CtrY, 180, 270, CtrY);
  SetFillStyle(WideDotFill, Cyan);
  PieSlice(CtrX, CtrY, 270, 360, CtrY);
  Rectangle(CtrX DIV 4, 0, MaxX - CtrX DIV 4, CtrY * 2 - 1);
  SetLineStyle(SolidLn, 0, NormWidth);
  Line(CtrX DIV 4, CtrY, MaxX - (CtrX DIV 4), CtrY);
  Line(CtrX , 0, CtrX, MaxY);
  XMax := MaxX DIV 4;
  IF MaxX = 320 THEN BEGIN
    corr1 := 16;
    corr2 := 16;
  END ELSE BEGIN
    corr1 := 8;
    corr2 := 4;
  END;
  FOR i := 0 TO GetMaxColor DO BEGIN
    xr := MaxX - XMax DIV 2 - 2;
    xl := (XMax DIV 2 + (XMax DIV (Succ(GetMaxColor) DIV corr2)
          * i) * 6 DIV corr1) + 2;
    IF xl > xr THEN xl := xr;
    SetFillStyle(SolidFill, i);
    SetColor(White);
    Bar(xl, CtrY DIV 2, xr, CtrY);
    IF GetMaxColor <= 15 THEN
      Rectangle(xl, CtrY DIV 2, xr, CtrY);
  END;
  FOR i := 0 TO 11 DO BEGIN
    SetFillStyle(i, White);
    Bar((XMax DIV 2 + (XMax DIV 8 * i) * 2) + 2,
        CtrY,
        (MaxX - (CtrX DIV 4) - 2),
        MaxY - CtrY DIV 2);
    Rectangle((XMax DIV 2 + (XMax DIV 8 * i) * 2) + 2,
              CtrY, (MaxX - (CtrX DIV 4) - 2),
              MaxY - CtrY DIV 2);
  END;
  SetColor(White);
  IF MaxX >= 799 THEN
    SetUserCharSize(1, 1, 1, 1)
  ELSE
   SetUserCharSize(1, 3, 1, 3);
  SetTextStyle(EuropeanFont, HorizDir, UserCharSize);
  SetFillStyle(InterleaveFill, DarkGray);
  Bar(CtrX - (TextWidth(GetModeName(gm)) DIV 2) - 8,
      MaxY - MaxY DIV 6 - (TextHeight('Pp') DIV 2) - 4,
      CtrX + (TextWidth(GetModeName(gm)) DIV 2) + 4,
      MaxY - MaxY DIV 6 + (TextHeight('Pp') DIV 2) + 8);
  Rectangle(CtrX - (TextWidth(GetModeName(gm)) DIV 2) - 8,
           MaxY - MaxY DIV 6 - (TextHeight('Pp') DIV 2) - 4,
           CtrX + (TextWidth(GetModeName(gm)) DIV 2) + 4,
           MaxY - MaxY DIV 6 + (TextHeight('Pp') DIV 2) + 8);
  SetTextJustify(CenterText, CenterText);
  SetFillStyle(SolidFill, Red);
  IF MaxX > 320 THEN BEGIN
    FontAttr := FilledOut;
    SetFillStyle(SolidFill, Red);
    SetColor(White);
    OutTextXY(CtrX, MaxY - MaxY DIV 6, GetModeName(gm));
    FontAttr := Normal;
  END ELSE BEGIN
    FontAttr := Normal;
    OutTextXY(CtrX, (MaxY - MaxY DIV 6), GetModeName(gm));
  END;
  SetTextStyle(SmallFont, VertDir, 4);
  SetTextJustify(LeftText, BottomText);
  SetColor(LightCyan);
  OutTextXY(GetMaxX - 12, GetMaxY - 10,
            '(C) 1993 te-wi Verlag');
  SetColor(White);
  Str(MemAvail DIV 1024, s);
  FontAttr := OutLine;
  SetTextStyle(SmallFont, HorizDir, 4);
  SetTextJustify(RightText, BottomText);
  OutTextXY(MaxX - CtrX DIV 4 - 5, MaxX DIV 40, s + ' KBytes RAM frei');
  ch := #0;
  REPEAT
    ch := ReadKey;
  UNTIL ch <> #0;
  CloseGraph;
END.

(*===================================================================*)