home *** CD-ROM | disk | FTP | other *** search
- unit Gr;
-
- { Unit Gr, Version 1.21.002, Copyright 1993 by Matthias Köppe.
-
- gr.inf gr.txt gr.doc grdpmi
-
- Gr ist eine gemeinsam genutzte Graphikverwaltungsunit. Sie dient der
- Bereitstellung von Graphikparametern und der Verwaltung der
- Speicherbelegung.
- }
-
-
- interface
-
- uses Objects;
-
- const
-
- { Konstanten für SetGrMode.
-
- Nur die mit einem Asterisk (*) versehenen Graphikmodus-Variationen dürfen
- zusammen mit BGI- oder BIOS-Routinen verwendet werden. Bei den anderen
- gibt es Konflikte mit der veränderten Seitenanordnung.
- }
- grVgaLoStd = 0; { * 640 x 200, 2 Seiten, normale Anordnung }
- grVgaLoPak = 1; { 640 x 200, 2 Seiten, gepackte Anordnung }
- grVgaMedStd = 2; { * 640 x 350, 2 Seiten, normale Anordnung }
- grVgaMedOne = 3; { * 640 x 350, 1 Seite }
- grVgaMedPak = 4; { 640 x 350, 2 Seiten, gepackte Anordnung }
- grVgaHiStd = 5; { * 640 x 480, 1 Seite }
- grSvgaStd = 6; { 800 x 600, 1 Seite }
- grVga256Std = 7; { 320 x 200, 1 Seite, 256 Farben }
- grVgaWdMedStd = 8; { 720 x 350, 2 Seiten, normale Anordnung }
- grVgaWdMedOne = 9; { 720 x 350, 1 Seite }
- grVgaWdMedPak = 10; { 720 x 350, 2 Seiten, gepackte Anordnung }
- grVgaWdHiStd = 11; { 720 x 480, 1 Seite }
-
- { SetGrMode setzt die Parameter des Graphikmodus, schaltet aber nicht in
- diesen um. Das Umschalten in einen Graphikmodus sollte entweder über das
- BGI (InitGraph), über SetBiosMode oder über systemspezifische Direkt-
- zugriffe erfolgen.
- }
- procedure SetGrMode(Mode: Word);
-
- { SetActivePage setzt die aktuellen Parameter ActivePage (die übergebene
- Nummer) und ActiveSeg (die Segmentadresse der angesprochenen Seite).
- }
- procedure SetActivePage(Page: Word);
-
- { SetVisualPage schaltet zur angegebenen Seite um. Dies geschieht durch einen
- direkten Zugriff auf die Hardware.
- }
- procedure SetVisualPage(Page: Word);
-
- { PageSeg ermittelt die Segmentadresse zu einer angegebenen Seite.
- Wenn Page verschieden von 0 und 1 ist, so wird ActiveSeg zurückgegeben.
- }
- function PageSeg(Page: Word): Word;
-
- { PageAddr ermittelt die gültige Segment:Offset-Adresse der angegebenen Seite.
- Wenn Page verschieden von 0 und 1 ist, so wird ActivePSeg:ActivePOfs
- zurückgegeben.
- }
- function PageAddr(Page: Word): pointer;
-
- { ReserveSegs reserviert im freien VGA-Speicher (Size) Paragraphen. Das
- Startsegment wird im niederwertigen Wort des Funktionsergebnisses zurück-
- gegeben. Das höherwertige Wort gibt die reservierte Größe an.
- Wenn Size = -1, so wird der größte verfügbare Speicherbereich reserviert.
- }
- function ReserveSegs(Size: Integer): LongInt;
-
- { SetBiosMode initialisiert die Graphikkarte durch einen BIOS-Funktions-
- aufruf. Der Parameter ist die BIOS-Nummer des gewünschten Graphikmodus.
- }
- procedure SetBiosMode(Mode: Byte);
-
- { RestoreTextMode kehrt zu dem gespeicherten Textmodus zurück.
- }
- procedure RestoreTextMode;
-
- { Extend überführt einen 640 Pixel breiten Modus in einen 720 Pixel
- breiten Modus.
- }
- procedure Extend;
-
- { Setzt den Zeichenursprung durch Koordinaten.
- }
- procedure SetDrawOrigin(x, y: Integer);
-
- { Setzt den Zeichenursprung durch Datenstruktur.
- }
- procedure SetDrawOriginP(var P: TPoint);
-
- { Setzt das Clipping-Rechteck durch Koordinaten.
- }
- procedure SetClipRect(x1, y1, x2, y2: Integer);
-
- { Setzt das Clipping-Rechteck durch Datenstruktur.
- }
- procedure SetClipRectR(var R: TRect);
-
- { Alle UserXX-Zeiger, die vor dem Aufruf des Initialisierungsteils nil sind,
- werden mit @UserDummy versehen. Dieses verhindert nil-call- und stack-
- param-Kollisionen.
- }
- procedure UserDummy;
-
- { Versieht alle unbelegten UserXX-Zeiger mit @UserDummy.
- }
- procedure FillUserXX;
-
- { Nummer des Graphikmodus
- }
- var
- GrMode: Word;
-
- { gespeicherte Bios-Modusnummer
- }
- var
- SavedTextMode: Byte;
-
- { Parameter des Graphikmodus
- }
- var
- SizeX, SizeY: Word;
- Page0Seg, Free0Seg, Page1Seg, Free1Seg, EndSeg: Word;
- GrFlags: Word;
- ScreenF: Word;
- RealBytesPerLine: Word;
-
- { aktuelle Parameter
- }
- var
- ActivePage: Word;
- ActiveSeg: Word;
- ActivePSeg: Word;
- ActivePOfs: Word;
- BytesPerLine: Word;
-
- { gemeinsam genutzte Zusatzparameter
- }
- var
- DrawOrigin: TPoint;
- ClipRect: TRect;
-
- { Anzahl der frei verfügbaren Zeiger
- }
- const
- UserCount = 16;
-
- { Parameteranzahlvorgabe für Aufrufmodell
- }
- procedure UserParams(Count: Word);
- inline($58 {pop ax});
-
- { Frei verfügbare Zeiger.
- Aufrufmodell: AX param word count
- }
- var
- User00: pointer;
- User01: pointer;
- User02: pointer;
- User03: pointer;
- User04: pointer;
- User05: pointer;
- User06: pointer;
- User07: pointer;
- User08: pointer;
- User09: pointer;
- User0A: pointer;
- User0B: pointer;
- User0C: pointer;
- User0D: pointer;
- User0E: pointer;
- User0F: pointer;
-
- { Qualitätsbytes
- }
- const
- Quality00: Byte = 0;
- Quality01: Byte = 0;
- Quality02: Byte = 0;
- Quality03: Byte = 0;
- Quality04: Byte = 0;
- Quality05: Byte = 0;
- Quality06: Byte = 0;
- Quality07: Byte = 0;
- Quality08: Byte = 0;
- Quality09: Byte = 0;
- Quality0A: Byte = 0;
- Quality0B: Byte = 0;
- Quality0C: Byte = 0;
- Quality0D: Byte = 0;
- Quality0E: Byte = 0;
- Quality0F: Byte = 0;
-
- { MetaGraph-Unterstützung
- }
- const
- ms_Draw = 1;
- ms_Record = 2;
- ms_BGI = 4;
- ms_Execute = 8;
-
- const
- MetaState: Word = ms_Draw or ms_BGI;
-
- var
- MetaClipRect: TRect;
- MetaOrigin: TPoint;
-
- var
- ExtSave: pointer absolute User00;
- qExtSave: Byte absolute Quality00;
-
- { Exportierte Line-Routine
- }
- type
- TLineProc = procedure(x1, y1, x2, y2: Integer);
- var
- LineProc: TLineProc absolute User01;
- qLineProc: Byte absolute Quality01;
-
- { Gr Clipping Notification
- }
- const
- gcnUpdAll = 1;
- gcnUpdOrigin = 2;
-
- gcnStopUpd = 10;
- gcnContUpd = 11;
- gcnHaltUpd = 12;
- gcnStartUpd = 13;
- gcnUpdOnReq = 14;
-
- type
- TClipNotifyProc = procedure(Msg: Word);
- var
- ClipNotifyProc: TClipNotifyProc absolute User02;
- qClipNotifyProc: Byte absolute Quality02;
-
- { Init Graphics proc
- }
- type
- TInitGraphProc = function: Boolean;
- var
- InitGraphProc: TInitGraphProc absolute User03;
- qInitGraphProc: Byte absolute Quality03;
-
- const
- qInitBiosGraph = 10;
-
- function InitBiosGraph: Boolean;
-
- { Close Graphics proc
- }
- var
- CloseGraphProc: procedure absolute User04;
- qCloseGraphProc: Byte absolute Quality04;
-
- const
- qCloseBiosGraph = 10;
-
- procedure CloseBiosGraph;
-
- { Set Active Page proc
- }
- var
- ActivePageProc: procedure absolute User05;
- qActivePageProc: Byte absolute Quality05;
-
- { Change Params proc
- }
- const
- gcpColor = 1;
- gcpLineStyle = 2;
- gcpSolidThLn = 3;
- gcpGetSize = $000;
- gcpGetParams = $100;
- gcpSetParams = $200;
-
- type
- TChParamsProc = function(Cmd: Word; var Buf): Word;
-
- var
- ChParamsProc: TChParamsProc absolute User06;
- qChParamsProc: Byte absolute Quality06;
-
- { Generic notification proc handling
- }
- const
- npInstall = 0;
- npUninstall = 1;
- npGetQuality = 2;
- npSetNext = 3;
-
- type
- TNotifyProc = function(Notice: Word; Info: LongInt): LongInt;
-
- procedure InstallNotifyProc(var Chain: TNotifyProc;
- Proc: TNotifyProc);
- procedure UninstallNotifyProc(var Chain: TNotifyProc;
- Proc: TNotifyProc);
- function DefaultNotify(Notice: Word; Info: LongInt; ThisProc: TNotifyProc;
- var NextProc: TNotifyProc; Quality: Byte): LongInt;
-
- { Graphics notification proc
- }
- var
- GrNotifyProc: TNotifyProc absolute User07;
- qGrNotifyProc: Byte absolute Quality07;
-
- { Address mapping function
- }
- type
- TMapAddrFunc = function(Linear: LongInt): pointer;
-
- var
- MapAddrFunc: TMapAddrFunc absolute User08;
- qMapAddrFunc: Byte absolute Quality08;
-
- const
- qVgaMapAddr = 10;
-
- function VgaMapAddr(Linear: LongInt): pointer;
-
- { Speicherung und Wiederherstellung der VGA-Register
- }
- procedure SaveRegs;
- procedure RestoreRegs;
-
- var
- UserRegArea: array[0..6] of Byte;
-
- { Protected mode support
- }
- function SelOfs(ParOfs: pointer): pointer;
-
- { Unterstützung der Version 6.0
- }
- const
- Seg0040: Word = $0040;
- SegA000: Word = $A000;
- SegB000: Word = $B000;
- SegB800: Word = $B800;
-
- function GetShiftState: Byte;
- procedure NewCache(var P: Pointer; Size: Word);
- procedure DisposeCache(P: Pointer);
-
- implementation
-