home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / das_buch / overlays / grafovr.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-05-07  |  6.8 KB  |  178 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. (*                              GRAFOVR.PAS                          *)
  5. (*                         (C) 1993 te-wi Verlag                     *)
  6. (*-------------------------------------------------------------------*)
  7. (* Demo- und Testprogramm für Grafiktreiber und -Fonts im Overlay.   *)
  8. (*===================================================================*)
  9.  
  10. PROGRAM GraphicsDemoWithOverlays;
  11.  
  12. USES
  13.   Overlay, Dos, Crt, Graph, BGIOvr;
  14.  
  15. {$O BGIDrv} {$O TRIP_} {$O LITT_} {$O SANS_} {$O GOTH_} {$O SIMP_}
  16. {$O EURO_}  {$O LCOM_} {$O BOLD_} {$O SCRI_} {$O TSCR_}
  17.  
  18. VAR
  19.   result,                            (* Checkvariable für Kontrollen *)
  20.   gd, gm,                            (* Treiber/Modus für InitGraph  *)
  21.   x1, x2, XMax,                      (* für Koordinatenberechnungen  *)
  22.   CtrX, CtrY,                        (* für Koordinatenberechnungen  *)
  23.   xr, xl,                            (* für Koordinatenberechnungen  *)
  24.   MaxX, MaxY  : INTEGER;             (* für Koordinatenberechnungen  *)
  25.   i           : BYTE;                (* Laufvariable für Fonts       *)
  26.   s1, s2      : STRING;              (* für Meldungen (OutTextXY)    *)
  27.   FDir        : DirStr;              (* Directory (für FSplit)       *)
  28.   FName       : NameStr;             (* Dateiname (für FSplit)       *)
  29.   FExt        : ExtStr;              (* Dateiendung (für FSplit)     *)
  30.  
  31. PROCEDURE PressAKey;
  32. VAR
  33.   ch: CHAR;
  34. BEGIN
  35.   ch := #0;
  36.   REPEAT
  37.    ch := ReadKey;
  38.  UNTIL ch <> #0;
  39. END;
  40.  
  41. PROCEDURE BoxMessage(s: STRING);
  42. VAR
  43.   col: WORD;
  44. BEGIN
  45.   col := GetColor;
  46.   SetTextJustify(CenterText, CenterText);
  47.   SetTextStyle(DefaultFont, HorizDir, 1);
  48.   SetFillStyle(SolidFill, LightGray);
  49.   Bar(MaxX - 24 - TextWidth(s), MaxY - 19, MaxX - 17, MaxY - 7);
  50.   Rectangle(MaxX - 25 - TextWidth(s), MaxY - 19, MaxX - 17, MaxY - 7);
  51.   SetColor(Black);
  52.   Line(MaxX - 24 - TextWidth(s), MaxY - 7, MaxX - 17, MaxY - 7);
  53.   Line(MaxX - 17, MaxY - 19, MaxX - 17, MaxY - 7);
  54.   SetColor(Black);
  55.   OutTextXY(MaxX - 40, MaxY - 12, s);
  56.   SetColor(col);
  57. END;
  58.  
  59. BEGIN
  60.   FSplit(ParamStr(0), FDir, FName, FExt);(* Overlay mit Programm-    *)
  61.   OvrInit(FDir + FName + '.OVR');        (* verzeichnis u. -Namen    *)
  62.                                          (* externes Overlay ???     *)
  63.   IF OvrResult = -2 THEN OvrInit(ParamStr(0)); (* angehängt!         *)
  64.   OvrInitEMS;                            (* Overlays im EMS          *)
  65.   IF OvrResult < -4 THEN OvrResult := 0; (* Kein EMS ist kein Fehler *)
  66.   IF OvrResult <> 0 THEN                 (* Fehler: Ende mit Message *)
  67.   BEGIN
  68.     WriteLn('Overlay-Fehler:  ', OvrResult);
  69.     ReadLn;
  70.     Halt;
  71.   END;
  72.   DetectGraph(gd, gm);                   (* Grafiktreiber ermitteln  *)
  73.   result := LoadDriver(gd);              (* ... vor InitGraph laden  *)
  74.   IF result < 0 THEN                     (* Fehler!!!                *)
  75.   BEGIN
  76.     WriteLn('Grafik-Overlay-Fehler Nummer ', result);
  77.     Halt;
  78.   END;
  79.   Str(MemAvail DIV 1024, s1);            (* freien Heap holen        *)
  80.   Str(OvrGetBuf DIV 1024, s2);           (* Overlay-Größe holen      *)
  81.   InitGraph(gd, gm, '');                 (* und jetzt erst initial.  *)
  82.   OvrMinimalBuf;                         (* Puffer verkleinern       *)
  83.   CheckSnow := FALSE;                    (* und ab hier das normale  *)
  84.   DirectVideo := TRUE;                   (* Programm ...             *)
  85.   result := GraphResult;
  86.   IF result < 0 THEN BEGIN
  87.     WriteLn(^G, GraphErrorMsg(result));
  88.     Halt;
  89.   END;
  90.   MaxX := GetMaxX + 1; CtrX := MaxX DIV 2;
  91.   MaxY := GetMaxY + 1; CtrY := MaxY DIV 2;
  92.   SetTextStyle(SmallFont, HorizDir, 4);
  93.   SetTextJustify(LeftText, BottomText);
  94.   OutTextXY(10, MaxX DIV 40, 'Initialisierungswerte:');
  95.   SetTextJustify(RightText, BottomText);
  96.   OutTextXY(MaxX - CtrX DIV 4 - 5,
  97.             MaxX DIV 40 + 20 , s2 + ' Kbytes Overlayspeicher belegt');
  98.   OutTextXY(MaxX - CtrX DIV 4 - 5, MaxX DIV 40,
  99.               s1 + ' Kbytes Heap frei');
  100.   SetTextJustify(RightText, BottomText);
  101.   SetTextStyle(DefaultFont, HorizDir, 1);
  102.   BoxMessage('Taste');
  103.   PressAKey;
  104.   SetFillStyle(SolidFill, DarkGray);
  105.   Bar(0,0, MaxX, MaxY);
  106.   SetBkColor(Black);
  107.   SetFillStyle(SolidFill, Red);
  108.   Bar(CtrX DIV 4, 0, MaxX - CtrX DIV 4, CtrY * 2 - 1);
  109.   IF MaxX > 320 THEN
  110.     SetLineStyle(SolidLn, 0, ThickWidth);
  111.   Circle(CtrX, CtrY, CtrY);
  112.   SetFillStyle(XHatchFill, LightBlue);
  113.   PieSlice(CtrX, CtrY, 0, 90, CtrY);
  114.   SetFillStyle(HatchFill, LightBlue);
  115.   PieSlice(CtrX, CtrY, 90, 180, CtrY);
  116.   SetFillStyle(CloseDotFill, LightCyan);
  117.   PieSlice(CtrX, CtrY, 180, 270, CtrY);
  118.   SetFillStyle(WideDotFill, Cyan);
  119.   PieSlice(CtrX, CtrY, 270, 360, CtrY);
  120.   SetColor(LightGray);
  121.   Rectangle(CtrX DIV 4, 0, MaxX - CtrX DIV 4, CtrY * 2 - 1);
  122.   SetColor(White);
  123.   SetLineStyle(SolidLn, 0, NormWidth);
  124.   Line(CtrX DIV 4, CtrY, MaxX - (CtrX DIV 4), CtrY);
  125.   Line(CtrX , 0, CtrX, MaxY);
  126.   XMax := MaxX DIV 4;
  127.   FOR i := 0 TO GetMaxColor DO BEGIN
  128.     xr := MaxX - XMax DIV 2 - 2;
  129.     xl := (XMax DIV 2 + (XMax DIV (Succ(GetMaxColor) DIV 4)
  130.           * i) * 6 DIV 8) + 2;
  131.     IF xl > xr THEN xl := xr;
  132.     SetFillStyle(SolidFill, i);
  133.     SetColor(White);
  134.     Bar(xl, CtrY DIV 2, xr, CtrY);
  135.     IF GetMaxColor <= 15 THEN Rectangle(xl, CtrY DIV 2, xr, CtrY);
  136.   END;
  137.   FOR i := 0 TO 11 DO BEGIN
  138.     SetFillStyle(i, White);
  139.     Bar((XMax DIV 2 + (XMax DIV 8 * i) * 2) + 2,
  140.         CtrY, (MaxX - (CtrX DIV 4) - 2), MaxY - CtrY DIV 2);
  141.     Rectangle((XMax DIV 2 + (XMax DIV 8 * i) * 2) + 2,
  142.               CtrY, (MaxX - (CtrX DIV 4) - 2),
  143.               MaxY - CtrY DIV 2);
  144.   END;
  145.   SetTextStyle(SmallFont, VertDir, 4);
  146.   SetTextJustify(LeftText, BottomText);
  147.   SetColor(LightCyan);
  148.   OutTextXY(GetMaxX - 12, GetMaxY - 50, '(C) 1993 te-wi Verlag');
  149.   SetColor(White);
  150.   Str(MemAvail DIV 1024, s1);
  151.   SetTextStyle(SmallFont, HorizDir, 4);
  152.   SetTextJustify(RightText, BottomText);
  153.   OutTextXY(MaxX - CtrX DIV 4 - 5, MaxX DIV 40,
  154.             s1 + ' Kbytes Heap frei');
  155.   Str(OvrGetBuf DIV 1024, s2);
  156.   OutTextXY(MaxX - CtrX DIV 4 - 5,
  157.             MaxX DIV 40 + 20 , s2 + ' Kbytes Overlayspeicher belegt');
  158.   BoxMessage('Taste');
  159.   FOR i := 0 TO 10 DO
  160.   BEGIN
  161.     SetColor(White);
  162.     SetUserCharSize(1, 3, 1, 3);
  163.     SetTextStyle(i, HorizDir, UserCharSize);
  164.     SetFillStyle(InterleaveFill, DarkGray);
  165.     Bar(CtrX - 84, MaxY - MaxY DIV 6 - 16,
  166.         CtrX + 84, MaxY - MaxY DIV 6 + 16);
  167.     Rectangle(CtrX - 84, MaxY - MaxY DIV 6 - 16,
  168.               CtrX + 84, MaxY - MaxY DIV 6 + 16);
  169.     SetTextJustify(CenterText, CenterText);
  170.     OutTextXY(CtrX, MaxY - MaxY DIV 6, GetModeName(gm));
  171.     IF i = 10 THEN BoxMessage('Ende!');
  172.     PressAKey;
  173.   END;
  174.   CloseGraph;
  175. END.
  176.  
  177. (*===================================================================*)
  178.