home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / das_buch / grafik / grapherg.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-05-09  |  11.7 KB  |  366 lines

  1. {$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,P-,Q-,R-,S-,T-,V-,X-}
  2. (*===================================================================*)
  3. (*                           GRAPHERG.PAS                            *)
  4. (*             Copyright (C) 1993 te-wi Verlag, München              *)
  5. (*              Allgemeine Ergänzungen zur Unit Graph                *)
  6. (*      Diese Unit MUSS nach Graph ins Programm eingebunden          *)
  7. (*                          werden!                                  *)
  8. (*===================================================================*)
  9. UNIT GraphErg;
  10.  
  11. INTERFACE
  12. TYPE
  13.   tFontAttr    =   (Normal,                       (* Standardschrift *)
  14.                     Bold,                         (* Fettschrift     *)
  15.                     Shadow,                       (* Schattenschrift *)
  16.                     FilledOut,                    (* Outline gefüllt *)
  17.                     OutLine,                      (* Outline-Schrift *)
  18.                     UnderLine);                   (* Unterstrichen   *)
  19. CONST
  20.   FontAttr : tFontAttr = Normal;                  (* Schriftattribut *)
  21.                                                   (* Voreinstellung  *)
  22.   result   : INTEGER   = 0;                       (* Fehlererkennung *)
  23.   grInvalidAttr        = -15;                     (* falsche Attri-  *)
  24.                                                   (* but-Zuweisung   *)
  25.  
  26. FUNCTION  RegisterBGIDriver(Driver : POINTER): INTEGER;
  27.                                                  (* -> neu wegen Ptr *)
  28. FUNCTION  DetectSVGA: BYTE;                      (* Typ der SVGA     *)
  29. FUNCTION  PatchDriver(PathToDriver: STRING;      (* externen Treiber *)
  30.           SVGAInit: BYTE): INTEGER;              (* patchen          *)
  31. PROCEDURE SVGAInternalDrv;                       (* interner Treiber *)
  32. PROCEDURE InitSVGA(PathToDriver: STRING);        (* externer Treiber *)
  33. PROCEDURE OutTextXY(x, y: INTEGER;               (* neue Textausgabe *)
  34.                     TextString: STRING);         (* mit verschiedenen*)
  35. PROCEDURE OutText(TextString: STRING);           (* Attributen       *)
  36.  
  37. IMPLEMENTATION
  38.  
  39. USES
  40.   DOS, Graph;
  41.  
  42. CONST
  43.   SVGADriverPtr: Pointer = NIL;
  44.  
  45. VAR
  46.   BGIBuffer   : ARRAY[0..5526] OF BYTE;
  47.   (* MUSS GLOBAL DEFINIERT SEIN, RATEN SIE EINMAL, WARUM! *)
  48.  
  49. FUNCTION RegisterBGIDriver(Driver : POINTER): INTEGER;
  50. VAR
  51.   s: STRING[99];
  52. BEGIN
  53.   RegisterBGIDriver := Graph.RegisterBGIDriver(Driver);
  54.   s[0] := #99;
  55.   Move(Driver^, s[1], Ord(s[0]));            (* welcher Treiber ???? *)
  56.   IF Pos('(SuperVGA)', s) > 0 THEN BEGIN
  57.     SVGADriverPtr     := Driver;             (* den brauchen wir noch *)
  58.     RegisterBGIDriver := 16;                 (* Dummywert über Null   *)
  59.   END;
  60. END;
  61.  
  62. FUNCTION DetectSVGA: BYTE;
  63. TYPE
  64.   tSVGA = RECORD
  65.     n: STRING[11];
  66.     c: BYTE;
  67.   END;
  68.  
  69. CONST
  70.   CardNum = 11;
  71.   SVGACards: ARRAY[1..CardNum] OF tSVGA = (
  72.   (n: 'TSENG';     c: $29), (n: 'PARADISE';  c: $58),
  73.   (n: 'WESTERN';   c: $58), (n: 'TRIDENT';   c: $5B),
  74.   (n: 'OAK';       c: $52), (n: 'V7';        c: $62),
  75.   (n: 'GENOA';     c: $79), (n: 'TECMAR';    c: $16),
  76.   (n: '761295520'; c: $54), (n: 'AWARD';     c: $58),
  77.   (n: 'SIGMA';     c: $29));   (* hier erweitern ! *)
  78.  
  79. VAR
  80.   Regs: Registers;
  81.   BIOS: ARRAY[0..254] OF CHAR ABSOLUTE $C000:$0000;
  82.   s   : ARRAY[0..254] OF CHAR;
  83.   i   : INTEGER;
  84. BEGIN
  85.   DetectSVGA := $FF;
  86.   Regs.AX := $1A00;
  87.   Intr($10, Regs);
  88.   IF Regs.AL = $1A THEN BEGIN
  89.     Regs.AX := $6F00;
  90.     Regs.BX := $0000;
  91.     Intr($10, Regs);
  92.     IF Regs.BX = $5637 (* 'V7' *) THEN BEGIN
  93.        DetectSVGA := $62;
  94.        Exit;
  95.     END;
  96.   END;
  97.   Move(BIOS, s, 255);
  98.   FOR i := 0 TO 254 DO s[i] := UpCase(s[i]);
  99.   FOR i := 1 TO CardNum DO WITH SVGACards[i] DO BEGIN
  100.     IF Pos(n, s) > 0 THEN BEGIN
  101.       DetectSVGA := c;
  102.       Exit;
  103.     END;
  104.   END;
  105. END;
  106.  
  107. FUNCTION PatchDriver(PathToDriver: STRING; SVGAInit: BYTE): INTEGER;
  108. VAR
  109.   f         : FILE;
  110.   fName     : STRING;
  111. BEGIN
  112.   PatchDriver := 0;
  113.   IF PathToDriver <> '' THEN
  114.     fName := PathToDriver + '\SVGA.BGI'
  115.   ELSE fName := 'SVGA.BGI';
  116.   IF Pos('\\', fName) > 0 THEN
  117.     Delete(fName, Pos('\\', fName), 1);
  118.   Assign(f, fName);
  119.   {$I-}
  120.   Reset(f, 1);
  121.   IF IOResult <> 0 THEN BEGIN
  122.     PatchDriver := grFileNotFound;
  123.     Exit;
  124.   END;
  125.   {$I+}
  126.   IF FileSize(f) <> 5527 THEN BEGIN
  127.     PatchDriver := grInvalidDriver;
  128.     Exit;
  129.   END;
  130.   BlockRead(f, BGIBuffer, 5527);
  131.   Close(f);
  132.   BGIBuffer[$431]  := SVGAInit;
  133.   BGIBuffer[$1030] := SVGAInit;
  134.   SVGADriverPtr := @BGIBuffer;
  135. END;
  136.  
  137. PROCEDURE SVGAInternalDrv;
  138. VAR
  139.   SVGAInit: BYTE;
  140.   gd, gm  : INTEGER;
  141. BEGIN
  142.   SVGAInit := DetectSVGA;
  143.   IF SVGAInit <> $FF THEN BEGIN
  144.     Move(SVGADriverPtr^, BGIBuffer, 5527);
  145.     BGIBuffer[$431]  := SVGAInit;
  146.     BGIBuffer[$1030] := SVGAInit;
  147.     SVGADriverPtr    := @BGIBuffer;
  148.     gd := InstallUserDriver('SVGA', SVGADriverPtr);
  149.     gd := RegisterBGIDriver(SVGADriverPtr);
  150.     gd := 16;
  151.     gm := 0;
  152.   END ELSE BEGIN
  153.     gd := VGA;
  154.     gm := VGAHi;
  155.   END;
  156.   InitGraph(gd, gm, '');
  157. END;
  158.  
  159. PROCEDURE InitSVGA(PathToDriver: STRING);
  160. VAR
  161.   result,
  162.   gd, gm      : INTEGER;
  163.   SVGAInit    : BYTE;
  164. BEGIN
  165.   DetectGraph(gd, gm);
  166.   IF gd = VGA THEN BEGIN
  167.     SVGAInit := DetectSVGA;
  168.     IF SVGAInit <> $FF THEN BEGIN
  169.       result := PatchDriver(PathToDriver, SVGAInit);
  170.       IF result = 0 THEN BEGIN
  171.         gd := InstallUserDriver('SVGA', SVGADriverPtr);
  172.         gd := RegisterBGIDriver(SVGADriverPtr);
  173.         gd := 16;          (* User-Treiber sind immer die Nummer 16! *)
  174.         gm := 0;           (* Im Treiber arbeitet nur Mode 0 richtig *)
  175.       END;
  176.     END;
  177.   END;
  178.   InitGraph(gd, gm, PathToDriver);
  179. END;
  180.  
  181. PROCEDURE OutTextXY(x, y: INTEGER; TextString: STRING);
  182. VAR
  183.   c1, c2     : WORD;
  184.   x1, x2, y2 : INTEGER;
  185.   f          : FillSettingsType;
  186.   ts         : TextSettingsType;
  187. BEGIN
  188.   CASE FontAttr OF
  189.     Normal:
  190.       Graph.OutTextXY(x, y, TextString);
  191.     Bold:
  192.       BEGIN
  193.         Graph.OutTextXY(x + 1, y, TextString);
  194.         Graph.OutTextXY(x    , y, TextString);
  195.       END;
  196.     FilledOut,
  197.     OutLine:
  198.       BEGIN
  199.         c1 := GetColor;
  200.         Graph.OutTextXY(x - 1, y    , TextString);
  201.         Graph.OutTextXY(x - 1, y - 1, TextString);
  202.         Graph.OutTextXY(x    , y - 1, TextString);
  203.         Graph.OutTextXY(x + 1, y    , TextString);
  204.         Graph.OutTextXY(x + 1, y + 1, TextString);
  205.         Graph.OutTextXY(x    , y + 1, TextString);
  206.         Graph.OutTextXY(x - 1, y + 1, TextString);
  207.         IF FontAttr = FilledOut THEN BEGIN
  208.           GetFillSettings(f);
  209.           SetColor(f.Color);
  210.         END ELSE SetColor(GetBkColor);
  211.         Graph.OutTextXY(x, y, TextString);
  212.         SetColor(c1);
  213.       END;
  214.     Shadow:
  215.       BEGIN
  216.         GetFillSettings(f);
  217.         c1 := f.Color;
  218.         c2 := GetColor;
  219.         SetColor(c1);
  220.         Graph.OutTextXY(x + 2, y + 2, TextString);
  221.         SetColor(c2);
  222.         Graph.OutTextXY(x, y, TextString);
  223.       END;
  224.     UnderLine:
  225.       BEGIN
  226.         GetTextSettings(ts);
  227.         Graph.OutTextXY(x, y, TextString);
  228.         IF ts.Horiz = LeftText THEN BEGIN
  229.           x1 := x;
  230.           x2 := x + TextWidth(TextString);
  231.         END ELSE IF ts.Horiz = CenterText THEN BEGIN
  232.           x1 := x - TextWidth(TextString) DIV 2;
  233.           x2 := x + TextWidth(TextString) DIV 2;
  234.         END ELSE IF ts.Horiz = RightText THEN BEGIN
  235.           x1 := x - TextWidth(TextString);
  236.           x2 := x;
  237.         END;
  238.         CASE ts.Vert OF
  239.           TopText:    y2 := TextHeight('Pp');
  240.           CenterText: y2 := TextHeight('Pp') DIV 4;
  241.           BottomText: y2 := - TextHeight('Pp') DIV 4;
  242.         END;
  243.         Line(x1, y + y2 + TextHeight('Pp') DIV 2,
  244.              x2, y + y2 + TextHeight('Pp') DIV 2);
  245.       END;
  246.     ELSE result := -15;
  247.   END;
  248. END;
  249.  
  250. PROCEDURE OutText(TextString: STRING);
  251. VAR
  252.   ts     : TextSettingsType;
  253.   x1, x2 : INTEGER;
  254.   y2     : INTEGER;
  255.   c1, c2 : WORD;
  256.   x,  y  : INTEGER;
  257.   f      : Graph.FillSettingsType;
  258. BEGIN
  259.   CASE FontAttr OF
  260.     Normal:
  261.       Graph.OutText(TextString);
  262.     Bold:
  263.       BEGIN
  264.         x := Graph.GetX;
  265.         y := Graph.GetY;
  266.         Graph.OutTextXY(x    , y, TextString);
  267.         Graph.OutTextXY(x + 1, y, TextString);
  268.         x := x + Graph.TextWidth(TextString);
  269.         Graph.MoveTo(Succ(x), y);
  270.       END;
  271.     FilledOut,
  272.     OutLine:
  273.       BEGIN
  274.         x := Graph.GetX;
  275.         y := Graph.GetY;
  276.         c1 := Graph.GetColor;
  277.         Graph.OutTextXY(x - 1, y    , TextString);
  278.         Graph.OutTextXY(x - 1, y - 1, TextString);
  279.         Graph.OutTextXY(x    , y - 1, TextString);
  280.         Graph.OutTextXY(x + 1, y    , TextString);
  281.         Graph.OutTextXY(x + 1, y + 1, TextString);
  282.         Graph.OutTextXY(x    , y + 1, TextString);
  283.         Graph.OutTextXY(x - 1, y + 1, TextString);
  284.         IF FontAttr = FilledOut THEN BEGIN
  285.           Graph.GetFillSettings(f);
  286.           Graph.SetColor(f.Color);
  287.         END ELSE Graph.SetColor(Graph.GetBkColor);
  288.         Graph.OutTextXY(x, y, TextString);
  289.         Graph.SetColor(c1);
  290.         x := x + Graph.TextWidth(TextString);
  291.         Graph.MoveTo(Succ(x), y);
  292.       END;
  293.     Shadow:
  294.       BEGIN
  295.         x := Graph.GetX;
  296.         y := Graph.GetY;
  297.         Graph.GetFillSettings(f);
  298.         c1 := f.Color;
  299.         c2 := Graph.GetColor;
  300.         Graph.SetColor(c1);
  301.         Graph.OutTextXY(x + 1, y + 1, TextString);
  302.         Graph.SetColor(c2);
  303.         Graph.OutTextXY(x, y, TextString);
  304.         x := x + Graph.TextWidth(TextString);
  305.         Graph.MoveTo(Succ(x), y);
  306.       END;
  307.     UnderLine:
  308.       BEGIN
  309.         GetTextSettings(ts);
  310.         Graph.OutTextXY(x, y, TextString);
  311.         IF ts.Horiz = LeftText THEN BEGIN
  312.           x1 := x;
  313.           x2 := x + TextWidth(TextString);
  314.         END ELSE IF ts.Horiz = CenterText THEN BEGIN
  315.           x1 := x - TextWidth(TextString) DIV 2;
  316.           x2 := x + TextWidth(TextString) DIV 2;
  317.         END ELSE IF ts.Horiz = RightText THEN BEGIN
  318.           x1 := x - TextWidth(TextString);
  319.           x2 := x;
  320.         END;
  321.         CASE ts.Vert OF
  322.           TopText:    y2 := TextHeight('Pp');
  323.           CenterText: y2 := TextHeight('Pp') DIV 4;
  324.           BottomText: y2 := - TextHeight('Pp') DIV 4;
  325.         END;
  326.         Line(x, y + TextHeight('Pp') DIV 2,
  327.              x + TextWidth(TextString),
  328.              y + TextHeight('Pp') DIV 2);
  329.         Graph.MoveTo(x + TextWidth(TextString), y);
  330.       END;
  331.     ELSE result := -15;
  332.   END;
  333. END;
  334.  
  335. FUNCTION GraphErrorMsg(ErrorCode: INTEGER): STRING;
  336. VAR
  337.   m : STRING;
  338. BEGIN
  339.   CASE ErrorCode OF
  340.     grOk            : m := 'Kein Fehler';
  341.     grNoInitGraph   : m := 'BGI-Grafik nicht installiert';
  342.     grNotDetected   : m := 'Grafikhardware nicht ermittelt';
  343.     grFileNotFound  : m := 'Grafiktreiber nicht gefunden';
  344.     grInvalidDriver : m := 'Falsches Grafiktreiberformat';
  345.     grNoLoadMem     : m := 'Nicht genug Speicher um '
  346.                          + 'Treiber zu laden';
  347.     grNoScanMem     : m := 'Speichermangel bei Scan-Fill';
  348.     grNoFloodMem    : m := 'Speichermangel bei Floodfill';
  349.     grFontNotFound  : m := 'Fontdatei nicht gefunden';
  350.     grNoFontMem     : m := 'Nicht genug Speicher um Font'
  351.                          + ' zu laden';
  352.     grInvalidMode   : m := 'Falscher Grafikmodus für den '
  353.                          + 'ausgewählten Treiber';
  354.     grError         : m := 'Allgemeiner Grafikfehler';
  355.     grIOerror       : m := 'Graphik-Ein-/Ausgabefehler';
  356.     grInvalidFont   : m := 'Falsche Fontdatei';
  357.     grInvalidFontNum: m := 'Falsche Fontnummer';
  358.     grInvalidAttr   : m := 'Unbekanntes Schriftattribut';
  359.     ELSE              m := 'Unerwarteter Fehler im Modul GraphErg';
  360.                                             (* nicht bei Borland *)
  361.   END;
  362.   GraphErrorMsg := m + '.';
  363. END;
  364.  
  365. END.
  366. (*===================================================================*)