home *** CD-ROM | disk | FTP | other *** search
- {$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,P-,Q-,R-,S-,T-,V-,X-}
- (*===================================================================*)
- (* GRAPHERG.PAS *)
- (* Copyright (C) 1993 te-wi Verlag, München *)
- (* Allgemeine Ergänzungen zur Unit Graph *)
- (* Diese Unit MUSS nach Graph ins Programm eingebunden *)
- (* werden! *)
- (*===================================================================*)
- UNIT GraphErg;
-
- INTERFACE
- TYPE
- tFontAttr = (Normal, (* Standardschrift *)
- Bold, (* Fettschrift *)
- Shadow, (* Schattenschrift *)
- FilledOut, (* Outline gefüllt *)
- OutLine, (* Outline-Schrift *)
- UnderLine); (* Unterstrichen *)
- CONST
- FontAttr : tFontAttr = Normal; (* Schriftattribut *)
- (* Voreinstellung *)
- result : INTEGER = 0; (* Fehlererkennung *)
- grInvalidAttr = -15; (* falsche Attri- *)
- (* but-Zuweisung *)
-
- FUNCTION RegisterBGIDriver(Driver : POINTER): INTEGER;
- (* -> neu wegen Ptr *)
- FUNCTION DetectSVGA: BYTE; (* Typ der SVGA *)
- FUNCTION PatchDriver(PathToDriver: STRING; (* externen Treiber *)
- SVGAInit: BYTE): INTEGER; (* patchen *)
- PROCEDURE SVGAInternalDrv; (* interner Treiber *)
- PROCEDURE InitSVGA(PathToDriver: STRING); (* externer Treiber *)
- PROCEDURE OutTextXY(x, y: INTEGER; (* neue Textausgabe *)
- TextString: STRING); (* mit verschiedenen*)
- PROCEDURE OutText(TextString: STRING); (* Attributen *)
-
- IMPLEMENTATION
-
- USES
- DOS, Graph;
-
- CONST
- SVGADriverPtr: Pointer = NIL;
-
- VAR
- BGIBuffer : ARRAY[0..5526] OF BYTE;
- (* MUSS GLOBAL DEFINIERT SEIN, RATEN SIE EINMAL, WARUM! *)
-
- FUNCTION RegisterBGIDriver(Driver : POINTER): INTEGER;
- VAR
- s: STRING[99];
- BEGIN
- RegisterBGIDriver := Graph.RegisterBGIDriver(Driver);
- s[0] := #99;
- Move(Driver^, s[1], Ord(s[0])); (* welcher Treiber ???? *)
- IF Pos('(SuperVGA)', s) > 0 THEN BEGIN
- SVGADriverPtr := Driver; (* den brauchen wir noch *)
- RegisterBGIDriver := 16; (* Dummywert über Null *)
- END;
- END;
-
- FUNCTION DetectSVGA: BYTE;
- TYPE
- tSVGA = RECORD
- n: STRING[11];
- c: BYTE;
- END;
-
- CONST
- CardNum = 11;
- SVGACards: ARRAY[1..CardNum] OF tSVGA = (
- (n: 'TSENG'; c: $29), (n: 'PARADISE'; c: $58),
- (n: 'WESTERN'; c: $58), (n: 'TRIDENT'; c: $5B),
- (n: 'OAK'; c: $52), (n: 'V7'; c: $62),
- (n: 'GENOA'; c: $79), (n: 'TECMAR'; c: $16),
- (n: '761295520'; c: $54), (n: 'AWARD'; c: $58),
- (n: 'SIGMA'; c: $29)); (* hier erweitern ! *)
-
- VAR
- Regs: Registers;
- BIOS: ARRAY[0..254] OF CHAR ABSOLUTE $C000:$0000;
- s : ARRAY[0..254] OF CHAR;
- i : INTEGER;
- BEGIN
- DetectSVGA := $FF;
- Regs.AX := $1A00;
- Intr($10, Regs);
- IF Regs.AL = $1A THEN BEGIN
- Regs.AX := $6F00;
- Regs.BX := $0000;
- Intr($10, Regs);
- IF Regs.BX = $5637 (* 'V7' *) THEN BEGIN
- DetectSVGA := $62;
- Exit;
- END;
- END;
- Move(BIOS, s, 255);
- FOR i := 0 TO 254 DO s[i] := UpCase(s[i]);
- FOR i := 1 TO CardNum DO WITH SVGACards[i] DO BEGIN
- IF Pos(n, s) > 0 THEN BEGIN
- DetectSVGA := c;
- Exit;
- END;
- END;
- END;
-
- FUNCTION PatchDriver(PathToDriver: STRING; SVGAInit: BYTE): INTEGER;
- VAR
- f : FILE;
- fName : STRING;
- BEGIN
- PatchDriver := 0;
- IF PathToDriver <> '' THEN
- fName := PathToDriver + '\SVGA.BGI'
- ELSE fName := 'SVGA.BGI';
- IF Pos('\\', fName) > 0 THEN
- Delete(fName, Pos('\\', fName), 1);
- Assign(f, fName);
- {$I-}
- Reset(f, 1);
- IF IOResult <> 0 THEN BEGIN
- PatchDriver := grFileNotFound;
- Exit;
- END;
- {$I+}
- IF FileSize(f) <> 5527 THEN BEGIN
- PatchDriver := grInvalidDriver;
- Exit;
- END;
- BlockRead(f, BGIBuffer, 5527);
- Close(f);
- BGIBuffer[$431] := SVGAInit;
- BGIBuffer[$1030] := SVGAInit;
- SVGADriverPtr := @BGIBuffer;
- END;
-
- PROCEDURE SVGAInternalDrv;
- VAR
- SVGAInit: BYTE;
- gd, gm : INTEGER;
- BEGIN
- SVGAInit := DetectSVGA;
- IF SVGAInit <> $FF THEN BEGIN
- Move(SVGADriverPtr^, BGIBuffer, 5527);
- BGIBuffer[$431] := SVGAInit;
- BGIBuffer[$1030] := SVGAInit;
- SVGADriverPtr := @BGIBuffer;
- gd := InstallUserDriver('SVGA', SVGADriverPtr);
- gd := RegisterBGIDriver(SVGADriverPtr);
- gd := 16;
- gm := 0;
- END ELSE BEGIN
- gd := VGA;
- gm := VGAHi;
- END;
- InitGraph(gd, gm, '');
- END;
-
- PROCEDURE InitSVGA(PathToDriver: STRING);
- VAR
- result,
- gd, gm : INTEGER;
- SVGAInit : BYTE;
- BEGIN
- DetectGraph(gd, gm);
- IF gd = VGA THEN BEGIN
- SVGAInit := DetectSVGA;
- IF SVGAInit <> $FF THEN BEGIN
- result := PatchDriver(PathToDriver, SVGAInit);
- IF result = 0 THEN BEGIN
- gd := InstallUserDriver('SVGA', SVGADriverPtr);
- gd := RegisterBGIDriver(SVGADriverPtr);
- gd := 16; (* User-Treiber sind immer die Nummer 16! *)
- gm := 0; (* Im Treiber arbeitet nur Mode 0 richtig *)
- END;
- END;
- END;
- InitGraph(gd, gm, PathToDriver);
- END;
-
- PROCEDURE OutTextXY(x, y: INTEGER; TextString: STRING);
- VAR
- c1, c2 : WORD;
- x1, x2, y2 : INTEGER;
- f : FillSettingsType;
- ts : TextSettingsType;
- BEGIN
- CASE FontAttr OF
- Normal:
- Graph.OutTextXY(x, y, TextString);
- Bold:
- BEGIN
- Graph.OutTextXY(x + 1, y, TextString);
- Graph.OutTextXY(x , y, TextString);
- END;
- FilledOut,
- OutLine:
- BEGIN
- c1 := GetColor;
- Graph.OutTextXY(x - 1, y , TextString);
- Graph.OutTextXY(x - 1, y - 1, TextString);
- Graph.OutTextXY(x , y - 1, TextString);
- Graph.OutTextXY(x + 1, y , TextString);
- Graph.OutTextXY(x + 1, y + 1, TextString);
- Graph.OutTextXY(x , y + 1, TextString);
- Graph.OutTextXY(x - 1, y + 1, TextString);
- IF FontAttr = FilledOut THEN BEGIN
- GetFillSettings(f);
- SetColor(f.Color);
- END ELSE SetColor(GetBkColor);
- Graph.OutTextXY(x, y, TextString);
- SetColor(c1);
- END;
- Shadow:
- BEGIN
- GetFillSettings(f);
- c1 := f.Color;
- c2 := GetColor;
- SetColor(c1);
- Graph.OutTextXY(x + 2, y + 2, TextString);
- SetColor(c2);
- Graph.OutTextXY(x, y, TextString);
- END;
- UnderLine:
- BEGIN
- GetTextSettings(ts);
- Graph.OutTextXY(x, y, TextString);
- IF ts.Horiz = LeftText THEN BEGIN
- x1 := x;
- x2 := x + TextWidth(TextString);
- END ELSE IF ts.Horiz = CenterText THEN BEGIN
- x1 := x - TextWidth(TextString) DIV 2;
- x2 := x + TextWidth(TextString) DIV 2;
- END ELSE IF ts.Horiz = RightText THEN BEGIN
- x1 := x - TextWidth(TextString);
- x2 := x;
- END;
- CASE ts.Vert OF
- TopText: y2 := TextHeight('Pp');
- CenterText: y2 := TextHeight('Pp') DIV 4;
- BottomText: y2 := - TextHeight('Pp') DIV 4;
- END;
- Line(x1, y + y2 + TextHeight('Pp') DIV 2,
- x2, y + y2 + TextHeight('Pp') DIV 2);
- END;
- ELSE result := -15;
- END;
- END;
-
- PROCEDURE OutText(TextString: STRING);
- VAR
- ts : TextSettingsType;
- x1, x2 : INTEGER;
- y2 : INTEGER;
- c1, c2 : WORD;
- x, y : INTEGER;
- f : Graph.FillSettingsType;
- BEGIN
- CASE FontAttr OF
- Normal:
- Graph.OutText(TextString);
- Bold:
- BEGIN
- x := Graph.GetX;
- y := Graph.GetY;
- Graph.OutTextXY(x , y, TextString);
- Graph.OutTextXY(x + 1, y, TextString);
- x := x + Graph.TextWidth(TextString);
- Graph.MoveTo(Succ(x), y);
- END;
- FilledOut,
- OutLine:
- BEGIN
- x := Graph.GetX;
- y := Graph.GetY;
- c1 := Graph.GetColor;
- Graph.OutTextXY(x - 1, y , TextString);
- Graph.OutTextXY(x - 1, y - 1, TextString);
- Graph.OutTextXY(x , y - 1, TextString);
- Graph.OutTextXY(x + 1, y , TextString);
- Graph.OutTextXY(x + 1, y + 1, TextString);
- Graph.OutTextXY(x , y + 1, TextString);
- Graph.OutTextXY(x - 1, y + 1, TextString);
- IF FontAttr = FilledOut THEN BEGIN
- Graph.GetFillSettings(f);
- Graph.SetColor(f.Color);
- END ELSE Graph.SetColor(Graph.GetBkColor);
- Graph.OutTextXY(x, y, TextString);
- Graph.SetColor(c1);
- x := x + Graph.TextWidth(TextString);
- Graph.MoveTo(Succ(x), y);
- END;
- Shadow:
- BEGIN
- x := Graph.GetX;
- y := Graph.GetY;
- Graph.GetFillSettings(f);
- c1 := f.Color;
- c2 := Graph.GetColor;
- Graph.SetColor(c1);
- Graph.OutTextXY(x + 1, y + 1, TextString);
- Graph.SetColor(c2);
- Graph.OutTextXY(x, y, TextString);
- x := x + Graph.TextWidth(TextString);
- Graph.MoveTo(Succ(x), y);
- END;
- UnderLine:
- BEGIN
- GetTextSettings(ts);
- Graph.OutTextXY(x, y, TextString);
- IF ts.Horiz = LeftText THEN BEGIN
- x1 := x;
- x2 := x + TextWidth(TextString);
- END ELSE IF ts.Horiz = CenterText THEN BEGIN
- x1 := x - TextWidth(TextString) DIV 2;
- x2 := x + TextWidth(TextString) DIV 2;
- END ELSE IF ts.Horiz = RightText THEN BEGIN
- x1 := x - TextWidth(TextString);
- x2 := x;
- END;
- CASE ts.Vert OF
- TopText: y2 := TextHeight('Pp');
- CenterText: y2 := TextHeight('Pp') DIV 4;
- BottomText: y2 := - TextHeight('Pp') DIV 4;
- END;
- Line(x, y + TextHeight('Pp') DIV 2,
- x + TextWidth(TextString),
- y + TextHeight('Pp') DIV 2);
- Graph.MoveTo(x + TextWidth(TextString), y);
- END;
- ELSE result := -15;
- END;
- END;
-
- FUNCTION GraphErrorMsg(ErrorCode: INTEGER): STRING;
- VAR
- m : STRING;
- BEGIN
- CASE ErrorCode OF
- grOk : m := 'Kein Fehler';
- grNoInitGraph : m := 'BGI-Grafik nicht installiert';
- grNotDetected : m := 'Grafikhardware nicht ermittelt';
- grFileNotFound : m := 'Grafiktreiber nicht gefunden';
- grInvalidDriver : m := 'Falsches Grafiktreiberformat';
- grNoLoadMem : m := 'Nicht genug Speicher um '
- + 'Treiber zu laden';
- grNoScanMem : m := 'Speichermangel bei Scan-Fill';
- grNoFloodMem : m := 'Speichermangel bei Floodfill';
- grFontNotFound : m := 'Fontdatei nicht gefunden';
- grNoFontMem : m := 'Nicht genug Speicher um Font'
- + ' zu laden';
- grInvalidMode : m := 'Falscher Grafikmodus für den '
- + 'ausgewählten Treiber';
- grError : m := 'Allgemeiner Grafikfehler';
- grIOerror : m := 'Graphik-Ein-/Ausgabefehler';
- grInvalidFont : m := 'Falsche Fontdatei';
- grInvalidFontNum: m := 'Falsche Fontnummer';
- grInvalidAttr : m := 'Unbekanntes Schriftattribut';
- ELSE m := 'Unerwarteter Fehler im Modul GraphErg';
- (* nicht bei Borland *)
- END;
- GraphErrorMsg := m + '.';
- END;
-
- END.
- (*===================================================================*)