home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / vpbgib1.zip / DGRAPH.PAS < prev    next >
Pascal/Delphi Source File  |  1996-08-08  |  54KB  |  1,967 lines
  1. {█▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀█}
  2. {█                                                       █}
  3. {█      Virtual Pascal Run-time Library v1.1             █}
  4. {█      BGI Graphics unit for PM applications            █}
  5. {█      ─────────────────────────────────────────────────█}
  6. {█      Copyright (C) 1996 fPrint UK Ltd                 █}
  7. {█      Written May-July 1996 by Allan Mertner           █}
  8. {█        Inspired by DIVERace by Michael Mrosowski      █}
  9. {█                                                       █}
  10. {▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀}
  11.  
  12. Unit dGraph;
  13.  
  14. Interface
  15.  
  16. {$Delphi+}
  17.  
  18. Uses
  19.   Use32, Os2Def, Os2Base, Os2PmApi, Strings, SysUtils, VPUtils;
  20.  
  21. type
  22.   EGraph = class(Exception);
  23.   Str12 = String[12];
  24.  
  25. Const
  26.   x_Size : Longint = 640;
  27.   y_Size : Longint = 480;
  28.   WindowTitle : string = 'BGI Window';
  29.  
  30.   grOk                =  0;  // error status values reported by graphresult }
  31.   grNoInitGraph       = -1;  // BGI graphics not installed
  32.   grNotDetected       = -2;  // Graphics hardware not detected
  33.   grFileNotFound      = -3;  // Device driver file not found
  34.   grInvalidDriver     = -4;  // Invalid device driver file
  35.   grNoLoadMem         = -5;  // Not enough memory to load driver
  36.   grNoScanMem         = -6;  // Out of memory in scan fill
  37.   grNoFloodMem        = -7;  // Out of memory in flood fill
  38.   grFontNotFound      = -8;  // Font file not found
  39.   grNoFontMem         = -9;  // Not enough memory to load font
  40.   grInvalidMode       = -10; // Invalid graphics mode for selected driver
  41.   grError             = -11; // Graphics error (generic error)
  42.   grIOerror           = -12; // Graphics I/O error
  43.   grInvalidFont       = -13; // Invalid font file
  44.   grInvalidFontNum    = -14; // Invalid font number
  45.  
  46.   Detect              = 0;
  47.   Black               = 0;       { Colour values }
  48.   Blue                = 1;
  49.   Green               = 2;
  50.   Cyan                = 3;
  51.   Red                 = 4;
  52.   Magenta             = 5;
  53.   Brown               = 6;
  54.   LightGray           = 7;
  55.   DarkGray            = 8;
  56.   LightBlue           = 9;
  57.   LightGreen          = 10;
  58.   LightCyan           = 11;
  59.   LightRed            = 12;
  60.   LightMagenta        = 13;
  61.   Yellow              = 14;
  62.   White               = 15;
  63.   EGA_Black           = 0;        { different than DOS BGI values }
  64.   EGA_Blue            = 1;
  65.   EGA_Green           = 2;
  66.   EGA_Cyan            = 3;
  67.   EGA_Red             = 4;
  68.   EGA_Magenta         = 5;
  69.   EGA_Brown           = 6;
  70.   EGA_LightGray       = 7;
  71.   EGA_DarkGray        = 8;
  72.   EGA_LightBlue       = 9;
  73.   EGA_LightGreen      = 10;
  74.   EGA_LightCyan       = 11;
  75.   EGA_LightRed        = 12;
  76.   EGA_LightMagenta    = 13;
  77.   EGA_Yello           = 14;
  78.   EGA_White           = 15;
  79.  
  80.   NormWidth           = 1;         { constants for line thickness }
  81.   ThickWidth          = 3;
  82.  
  83.   SolidLn             = 0;         { constants for line patterns }
  84.   DottedLn            = 1;
  85.   CenterLn            = 2;
  86.   DashedLn            = 3;
  87.   UserBitLn           = 4;
  88.  
  89.   DefaultFont         = 0;         { font constants for settextstyle }
  90.   TriplexFont         = 1;
  91.   SmallFont           = 2;
  92.   SansSerifFont       = 3;
  93.   GothicFont          = 4;
  94.   ScriptFont          = 5;
  95.   SimplexFont         = 6;
  96.   TriplexScrFont      = 7;
  97.   ComplexFont         = 8;
  98.   EuropeanFont        = 9;
  99.   BoldFont            = 10;
  100.   FontNames : Array[1..10] of Str12
  101.             = ( 'TRIP.CHR', 'LITT.CHR', 'SANS.CHR', 'GOTH.CHR', 'SCRI.CHR',
  102.                 'SIMP.CHR', 'TSCR.CHR', 'LCOM.CHR', 'EURO.CHR', 'BOLD.CHR' );
  103.  
  104.   HorizDir            =  0;
  105.   VertDir             =  90;
  106.   UserCharSize        =  0;
  107.  
  108.   ClipOn              =  TRUE;
  109.   ClipOff             =  FALSE;
  110.  
  111.   TopOn               =  TRUE;
  112.   TopOff              =  FALSE;
  113.  
  114.   EmptyFill           = 0;         { fill patterns }
  115.   SolidFill           = 1;
  116.   LineFill            = 2;
  117.   LtSlashFill         = 3;
  118.   SlashFill           = 4;
  119.   BkSlashFill         = 5;
  120.   LtBkSlashFill       = 6;
  121.   HatchFill           = 7;
  122.   XHatchFill          = 8;
  123.   InterleaveFill      = 9;
  124.   WideDotFill         = 10;
  125.   CloseDotFill        = 11;
  126.   UserFill            = 12;
  127.  
  128.   NormalPut           = 0;      { operators for image blits and setwritemode }
  129.   CopyPut             = 0;
  130.   XORPut              = 1;
  131.   OrPut               = 2;
  132.   AndPut              = 3;
  133.   NotPut              = 4;
  134.  
  135.   LeftText            = 0;      { text justification constants }
  136.   CenterText          = 1;
  137.   RightText           = 2;
  138.   BottomText          = 0;
  139.   TopText             = 2;
  140.  
  141.   MaxColors           = 255;    // Different from DOS
  142.  
  143.   LinePatterns        : Array[0..3] of Word
  144.                       = ( $FFFFFFFF, $33333333, $3CCF3CCF, $0F0F0F0F );
  145.  
  146. type
  147.   str4 = String[4];
  148.   FillPatternType       = array [1..8] of Byte;
  149.   NewPatternType        = array [0..15] of SmallWord;
  150.   IntArray              = array [0..65000] of Integer;
  151.  
  152.   PaletteType           = record
  153.                               Size    : word;
  154.                               Colors  : array[0..MaxColors] of Byte;
  155.                           end;
  156.  
  157.   LineSettingsType      = record
  158.                               LineStyle : Word;
  159.                               Pattern   : Word;
  160.                               Thickness : Word;
  161.                           end;
  162.  
  163.   TextSettingsType      = record
  164.                               Font      : Word;
  165.                               Direction : Word;
  166.                               CharSize  : Integer;      { different than DOS BGI }
  167.                               Horiz     : Word;
  168.                               Vert      : Word;
  169.                               userxscale: double;
  170.                               useryscale: double;
  171.                           end;
  172.  
  173.   FillSettingsType      = record
  174.                               Pattern   : Word;
  175.                               Color     : Word;
  176.                           end;
  177.  
  178.   PointType             = record
  179.                               X         : Integer;
  180.                               Y         : Integer;
  181.                           end;
  182.   PointArray = Array[0..65000] of PointType;
  183.  
  184.   ViewPortType          = record
  185.                               X1        : Integer;
  186.                               Y1        : Integer;
  187.                               X2        : Integer;
  188.                               Y2        : Integer;
  189.                               Clip      : Boolean;
  190.                           end;
  191.  
  192.   ArcCoordsType         = record
  193.                               X         : Integer;
  194.                               Y         : Integer;
  195.                               Xstart    : Integer;
  196.                               Ystart    : Integer;
  197.                               Xend      : Integer;
  198.                               Yend      : Integer;
  199.                           end;
  200.  
  201.   MouseStatusType       = record
  202.                               X         : Integer;
  203.                               Y         : Integer;
  204.                               LButt     : Integer;
  205.                               MButt     : Integer;
  206.                               RButt     : Integer;
  207.                               NewInfo   : Integer;
  208.                           end;
  209.  
  210. procedure Delay(MS: Longint);
  211. function  KeyPressed: Boolean;
  212. function  ReadKey: Char;
  213. function  AltPressed: Boolean;
  214. function  ShiftPressed: Boolean;
  215. function  CtrlPressed: Boolean;
  216. procedure WaitDraw;
  217.  
  218. { BGI Function Prototypes }
  219.  
  220. Procedure Arc(X, Y: Integer; StAngle, EndAngle, Radius: Word);
  221. Procedure Bar(X1, Y1, X2, Y2: Integer);
  222. Procedure Bar3D(X1, Y1, X2, Y2: Integer; Depth: Word; Top: Boolean);
  223. Procedure Circle(X, Y: Integer; Radius: Word);
  224. Procedure ClearDevice;
  225. Procedure ClearViewport;
  226. Procedure CloseGraph;
  227. procedure DetectGraph(var GraphDriver, GraphMode: Integer);
  228. Procedure DrawPoly(NumPoints: Word; var PolyPoints);
  229. Procedure Ellipse(X, Y: Integer; StAngle, EndAngle: Word; XRadius, YRadius: Word);
  230. Procedure FillEllipse(X, Y: Integer; XRadius, YRadius: Word);
  231. Procedure FillPoly(NumPoints: Word; var PolyPoints);
  232. Procedure FloodFill(X, Y: Integer; Border: Word);
  233. Procedure GetArcCoords(var ArcCoords: ArcCoordsType);
  234. Procedure GetAspectRatio(var Xasp, Yasp: Word);
  235. Function  GetBkColor: Word;
  236. Function  GetColor: Word;
  237. Procedure GetDefaultPalette(var Palette: PaletteType);
  238. Function  GetDriverName: string;
  239. Procedure GetFillPattern(var FillPattern: FillPatternType);
  240. Procedure GetFillSettings(var FillInfo: FillSettingsType);
  241. function  GetGraphMode: Integer;
  242. function  GetFrameRate: Double;  // Frames Per Second
  243. function  GetFrameTime: Double;  // Time (mSec) Per Frame
  244. procedure GetImage(x1, y1, x2, y2: Integer; var BitMap);
  245. Procedure GetLineSettings(var LineInfo: LineSettingsType);
  246. Function  GetMaxColor: Word;
  247. Function  GetMaxX: Word;
  248. Function  GetMaxY: Word;
  249. Function  GetModeName(ModeNumber: Integer): string;
  250. Procedure GetPalette(var Palette: PaletteType);
  251. Function  GetPaletteSize: Integer;
  252. Function  GetPixel(X,Y: Integer): Word;
  253. Procedure GetTextSettings(var TextInfo: TextSettingsType);
  254. Procedure GetViewSettings(var ThisViewPort: ViewPortType);
  255. Function  GetX: Integer;
  256. Function  GetY: Integer;
  257. Procedure GraphDefaults;
  258. Function  GraphErrorMsg(ErrorCode: Integer): String;
  259. Function  GraphResult: Integer;
  260. function  ImageSize(x1, y1, x2, y2: Integer): Word;
  261. procedure InitGraph(var GraphDriver:Integer; var GraphMode: Integer;
  262.     PathToDriver: string);
  263. Function  InstallUserFont(FontFileName: string) : Integer;
  264. Procedure Line(X1, Y1, X2, Y2: Integer);
  265. Procedure LineRel(Dx, Dy: Integer);
  266. Procedure LineTo(X, Y: Integer);
  267. Procedure MoveRel(Dx, Dy: Integer);
  268. Procedure MoveTo(X, Y: Integer);
  269. Procedure OutText(TextString: string);
  270. Procedure OutTextXY(X, Y: Integer; TextString: string);
  271. Procedure PieSlice(X, Y: Integer; StAngle, EndAngle, Radius: Word);
  272. procedure PutImage(X, Y: Integer; var BitMap; BitBlt: Word);
  273. Procedure PutPixel(X, Y: Integer; Color: Word);
  274. Procedure Rectangle(X1, Y1, X2, Y2: Integer);
  275. Procedure RegisterBGIFont(FontID: Integer; Font: Pointer);
  276. Procedure Sector(X, Y: Integer; StAngle, EndAngle, XRadius, YRadius: Word);
  277. Procedure SetAllPalette(var Palette: PaletteType);
  278. Procedure SetAspectRatio(Xasp, Yasp: Word);
  279. Procedure SetBkColor(ColorNum: Word);
  280. Procedure SetColor(Color: Word);
  281. Procedure SetFillPattern(Pattern: FillPatternType; Color: Word);
  282. Procedure SetFillStyle(Pattern: Word; Color: Word);
  283. Procedure SetLineStyle(LineStyle: Word; Pattern: Word; Thickness: Word);
  284. Procedure SetPalette(ColorNum: Word; Color: Byte);
  285. Procedure SetRGBPalette(ColorNum: Word; Red, Green, Blue: Byte);
  286. Procedure SetTextJustify(Horiz, Vert: Word);
  287. Procedure SetTextStyle(Font, Direction, CharSize: Integer);
  288. Procedure SetUserCharSize(MultX, DivX, MultY, DivY: Word);
  289. Procedure SetViewPort(X1, Y1, X2, Y2: Integer; Clip: Boolean);
  290. Procedure SetWriteMode(WriteMode: Integer);
  291. Function  TextHeight(TextString: string): Word;
  292. Function  TextWidth(TextString: string): Word;
  293.  
  294. // VP additional BGI functions
  295. procedure SetWideFillPattern(Pattern: NewPatternType; Color: Word);
  296.  
  297. // Blitter control functions
  298. procedure SuspendRefresh;   // Suspend refreshing of screen
  299. procedure EnableRefresh;    // Enable refreshing of screen
  300. procedure AcceleratedBlit;  // Enable faster blitting routine (Only updated DIVE.DLL)
  301. procedure SlowBlit;         // Enable slow blitting routine
  302. // procedure SetBlitterPriority(Priority: Integer);
  303.  
  304. // Constants modifying behavious of Graph
  305. const
  306.   WaitKeypressed : Boolean = True;  // Delay() when calling keypressed
  307.  
  308. {$IFDEF DEBUG}
  309. procedure log( s: String );
  310. {$ENDIF}
  311.  
  312. Implementation
  313.  
  314. uses
  315.   Os2Dive;
  316.  
  317. {$IFDEF DEBUG}
  318. procedure log( s: String );
  319. begin
  320.   os2dive.log(s);
  321. end;
  322. {$ENDIF}
  323.  
  324. const
  325.   MaxFonts = 20;
  326.   FontScale: Array[ 1..10 ] of Double
  327.            = ( 0.60, 0.66, 0.75, 1.0, 1.33, 1.66, 2.0, 2.5, 3.0, 4.0);
  328.  
  329. type
  330.   tFont = record
  331.     FirstChar: Char;
  332.     Chars: Byte;
  333.     LastChar: Char;
  334.     Org_To_Top : smallint;
  335.     Org_To_Base : smallint;
  336.     Org_To_Dec  : smallint;
  337.     CharIndex: Array[0..255] of SmallWord;
  338.     CharWidth: Array[0..255] of Byte;
  339.     ChDataMem: Integer;
  340.     CharData: Pointer;
  341.     FontName: String;
  342.     Linked: Boolean;
  343.   end;
  344.   tGraphWindow = class( tDiveWindow )
  345.   private
  346.     Position  : PointType;    // Current position
  347.     FgColor   : Longint;      // Background color
  348.     BkColor   : Longint;      // Background color
  349.     TxtHoriz  : Byte;         // Horizontal text alignment
  350.     TxtVert   : Byte;         // Vertical text alignment
  351.     TxtDir    : Integer;      // Txt angle
  352.     FntSel    : Integer;      // Currently selected font
  353.     xScale    : Double;       // Txt Scaling factor
  354.     yScale    : Double;       // Txt Scaling factor
  355.     UserxScale: Double;       // User Txt Scaling factor (CharSz = 0)
  356.     UseryScale: Double;       // User Txt Scaling factor (CharSz = 0)
  357.     CharSz    : Integer;
  358.     PalInfo   : PaletteType;
  359.     LineInfo  : LineSettingsType;
  360.     FillInfo  : FillSettingsType;
  361.     WriteMode : Integer;      // Write mode (or, xor, etc)
  362.   public
  363.     constructor Create( SizeX, SizeY: Longint; ColorBits: Byte; WindowTitle:string );
  364.   end;
  365.  
  366.   tBGI = record
  367.     Fonts: 0..MaxFonts;
  368.     Font: Array[1..MaxFonts] of tFont;
  369.     PathToFont: String[80];
  370.     LastError : Longint;      // Last error
  371.     DW : tGraphWindow;
  372.   end;
  373.  
  374. // State variables
  375. var
  376.   BGI : tBGI;
  377.   GrStatus: Integer;
  378.   SaveExit: Pointer;     // After InitGraph, contains ExitProc
  379.   tidMessage : Integer;  // Thread ID of message handling loop
  380.  
  381. constructor tGraphWindow.Create( SizeX, SizeY: Longint; ColorBits: Byte ;WindowTitle:String);
  382. begin
  383.   Inherited Create( SizeX, SizeY, ColorBits{, WindowTitle});
  384.   VPClip := False;
  385.   inherited SetViewPort( 0, 0, SizeX-1, SizeY-1 );
  386.   FgColor := White;
  387.   BkColor := Black;
  388.   xScale := 1;
  389.   yScale := 1;
  390.   UserxScale := 1;
  391.   UseryScale := 1;
  392.   CharSz := 1;
  393.   TxtDir := 0;
  394.   TxtHoriz := LeftText;
  395.   TxtVert := TopText;
  396.   FntSel := DefaultFont;
  397.   PalInfo.Size := Colours;  // Ask DIVE for color count
  398.   GetDefaultPalette( PalInfo );
  399.   LineInfo.LineStyle := SolidLn;
  400.   LineInfo.Thickness := NormWidth;
  401.   LineInfo.Pattern := $FFFF;
  402.   FillInfo.Color:=White;
  403.   FillInfo.Pattern:= SolidFill;
  404.   SetLineThickness( LineInfo.Thickness );
  405.   xAspect := 10000;
  406.   yAspect := xAspect;  // Default 1:1 aspect ratio
  407.   WriteMode := NormalPut;
  408. //  Statistics := True;
  409. end;
  410.  
  411. Procedure Arc(X, Y: Integer; StAngle, EndAngle, Radius: Word);
  412. Var
  413.   Center: Pixel;
  414. begin
  415.   If Assigned( BGI.DW ) then
  416.     With BGI.DW do
  417.       begin
  418.         Center.x := x;
  419.         Center.y := y;
  420.         LineMode := True;
  421.         BeginUpdate;
  422.         DrawArc( Center, Radius, StAngle, EndAngle, FgColor );
  423.         EndUpdate;
  424.       end;
  425. end;
  426.  
  427. Procedure Bar(X1, Y1, X2, Y2: Integer);
  428. begin
  429.   If Assigned( BGI.DW ) then
  430.     with BGI.DW do
  431.     begin
  432.       BeginUpdate;
  433.       DrawFillRect( x1,y1, x2,y2, FgColor );
  434.       EndUpdate;
  435.     end;
  436. end;
  437.  
  438. Procedure Bar3D(X1, Y1, X2, Y2: Integer; Depth: Word; Top: Boolean );
  439. var
  440.   dy: Integer;
  441.   Poly: Array[1..5] of PointType;
  442. begin
  443.   If Assigned( BGI.DW ) then
  444.     with BGI.DW do
  445.       begin
  446.         BeginUpdate;
  447.         LineMode := True;
  448.         If Depth = 0 then
  449.           DrawBox( x1,y1, x2,y2, FgColor )
  450.         else
  451.           DrawFillRect( x1,y1, x2,y2, FgColor );
  452.         if Depth <> 0 then
  453.           begin
  454.             dy := (Depth*3) div 4;
  455.             DrawLine( x2,y2, x2+depth,y2-dy, FgColor );
  456.             DrawLine( x2+depth,y2-dy, x2+depth, y1-dy, FgColor );
  457.  
  458.             if top then
  459.               begin
  460.                 DrawLine( x1,y1, x1+depth,y1-dy, FgColor );
  461.                 DrawLine( x1+depth,y1-dy, x2+Depth,y1-dy, FgColor );
  462.                 DrawLine( x2+Depth,y1-dy, x2,y1, FgColor );
  463.               end;
  464.           end;
  465.         EndUpdate;
  466.       end;
  467. end;
  468.  
  469. Procedure Circle(X, Y: Integer; Radius: Word);
  470. Var
  471.   Center: Pixel;
  472. begin
  473.   If Assigned( BGI.DW ) then
  474.     with BGI.DW, LineInfo do
  475.       begin
  476.         Center.x := x;
  477.         Center.y := y;
  478.         LineMode := True;
  479.         BeginUpdate;
  480.         if LineStyle = UserBitLn then
  481.           SetLinePattern( Pattern )
  482.         else
  483.           SetLinePattern( LinePatterns[LineStyle] );
  484.         SetLineThickness( LineInfo.Thickness );
  485.         LinePutMode := WriteMode;
  486.         DrawArc( Center, Radius, 0, 360, FgColor );
  487.         EndUpdate;
  488.       end;
  489. end;
  490.  
  491. Procedure ClearDevice;
  492. begin
  493.   if Assigned( BGI.DW ) then
  494.     with BGI.DW do
  495.       begin
  496.         BeginUpdate;
  497.         Clear( BkColor );
  498.         EndUpdate;
  499.         Position.X := 0;
  500.         Position.X := 0;
  501.         FillColor := White;
  502.         FillBkColor := Black;
  503.       end;
  504. end;
  505.  
  506. Procedure ClearViewport;
  507. begin
  508.   if Assigned( BGI.DW ) then
  509.     with BGI.DW do
  510.       begin
  511.         BeginUpdate;
  512.         LineMode := False;
  513.         DrawBox( 0, 0, VPWidth, VPHeight, BkColor );
  514.         EndUpdate;
  515.         Position.X := 0;
  516.         Position.X := 0;
  517.         FillColor := White;
  518.         FillBkColor := Black;
  519.       end;
  520. end;
  521.  
  522. Procedure CloseGraph;
  523. var
  524.   timeout: Integer;
  525. begin
  526.   If Assigned( BGI.DW ) then
  527.     begin
  528.       if SaveExit <> nil then
  529.         begin
  530.           ExitProc := SaveExit;
  531.           SaveExit := nil;
  532.         end;
  533.       WinPostMsg( BGI.DW.hwndFrame, WM_CLOSE, 0, 0 );
  534.       WinPostMsg( BGI.DW.hwndFrame, ID_EXIT, 0, 0 );
  535.       timeout := 0;
  536.       if GetThreadID <> tidMessage then  // Msg handling thread should not wait!
  537.         While ( BGI.DW <> nil ) and (timeOut < 50) do
  538.           begin
  539.             DosSleep( 50 );
  540.             Inc(TimeOut );
  541.           end;
  542.     end;
  543. end;
  544.  
  545. procedure DetectGraph(var GraphDriver, GraphMode: Integer);
  546. begin
  547.   GraphDriver := 9;  // 640x480 VGA
  548.   GraphMode := 2;
  549. end;
  550.  
  551. Procedure DrawPoly(NumPoints: Word; var PolyPoints);
  552. var
  553.   i : Integer;
  554.   p,q : ^PointType;
  555. begin
  556.   if Assigned( BGI.DW ) then
  557.     with BGI.DW do
  558.       begin
  559.         LinePutMode := WriteMode;
  560.         p := @PolyPoints;
  561.         q := p;
  562.         inc(q);
  563.         BeginUpdate;
  564.         for i := 0 to NumPoints-2 do
  565.           begin
  566.             DrawLine( p^.x, p^.y, q^.x, q^.y, FgColor );
  567.             inc( p );
  568.             inc( q );
  569.           end;
  570.         Position.x := p^.x;
  571.         Position.y := p^.y;
  572.         LinePutMode := NormalPut;
  573.         EndUpdate;
  574.       end;
  575. end;
  576.  
  577. Procedure Ellipse(X, Y: Integer; StAngle, EndAngle: Word; XRadius, YRadius: Word);
  578. Var
  579.   Center: Pixel;
  580. begin
  581.   If Assigned( BGI.DW ) then
  582.     with BGI.DW do
  583.       begin
  584.         Center.x := x;
  585.         Center.y := y;
  586.         LineMode := True;
  587.         BeginUpdate;
  588.         DrawEllipse( Center, XRadius, YRadius, StAngle, EndAngle, FgColor );
  589.         EndUpdate;
  590.       end;
  591. end;
  592.  
  593. Procedure FillEllipse(X, Y: Integer; XRadius, YRadius: Word);
  594. Var
  595.   Center: Pixel;
  596.   v: Integer;
  597.   y1 : Integer;
  598.   x2,y2 : Integer;
  599.   row: Integer;
  600. begin
  601.   If Assigned( BGI.DW ) then
  602.     with BGI.DW do
  603.       begin
  604.         Center.x := x;
  605.         Center.y := y;
  606.         LineMode := False;
  607.         BeginUpdate;
  608.         y2 := YRadius;
  609.         for v := 90 downto 0 do  // Quarter circle
  610.           begin
  611.             y1 := y2;
  612.             x2 := (XRadius*tCos[v*4]) div 1024;
  613.             y2 := (YRadius*tSin[v*4]) div 1024;
  614.             for row := y2 to y1-1 do
  615.               If FillInfo.Pattern = SolidFill then
  616.                 begin
  617.                   DrawLine( x-x2, y+Row, x+x2, y+Row, FillInfo.Color );
  618.                   DrawLine( x-x2, y-Row, x+x2, y-Row, FillInfo.Color );
  619.                 end
  620.               else
  621.                 begin
  622.                   DrawFillLine( x-x2, x+x2, y+Row );
  623.                   DrawFillLine( x-x2, x+x2, y-Row );
  624.                 end;
  625.           end;
  626.         EndUpdate;
  627.         Ellipse( x,y, 0,360, XRadius, YRadius );
  628.       end;
  629. end;
  630.  
  631. Procedure FillPoly(NumPoints: Word; var PolyPoints);
  632. VAR
  633.   i,j,k      : Integer;
  634.   xi         : ^IntArray;
  635.   PointMem   : Integer;
  636.   InP        : ^PointArray;
  637.   ymin, ymax : Integer;
  638.   Row        : Integer;
  639.   Col        : Integer;
  640.  
  641. BEGIN
  642.   PointMem := NumPoints*Sizeof(Integer);
  643.   GetMem( xi, PointMem );
  644.   fillchar( xi^, PointMem, 0 );
  645.   InP := @PolyPoints;         // Make it easier to address points
  646.   with InP^[0] do
  647.     begin
  648.       ymin := y;
  649.       ymax := y;
  650.       moveto(x, y);
  651.     end;
  652.   for i := 1 to NumPoints-1 do
  653.     with Inp^[i] do
  654.       begin
  655.         ymin := min( y, ymin );
  656.         ymax := max( y, ymax );
  657.       end;
  658.  
  659.   with BGI.DW do
  660.     begin
  661.       BeginUpdate;
  662.       yMax := Max( 0, Min( GetMaxY-1, yMax ) );
  663.       for Row := ymin to ymax do
  664.         begin
  665.           j := 0;
  666.           for i := 1 to NumPoints-1 do
  667.             with Inp^[ pred(i) ] do
  668.               if ( (y < Row) xor ( InP^[i].y < Row ) ) then
  669.                 begin
  670.                   Col := x+(Row-y)*(x-InP^[i].x) div (y-InP^[i].y);
  671.                   k:=0;
  672.                   while ( k<>j ) and ( Col >= xi^[k] ) do
  673.                     Inc( k );
  674.                   IF k < j then
  675.                     move( xi^[k], xi^[succ(k)], (j-k)*sizeof(integer) );
  676.                   xi^[k] := Col;
  677.                   Inc( j );
  678.                 end;
  679.           for i := 0 to j-2 do
  680.             begin
  681.               DrawFillLine( xi^[i], xi^[succ(i)], Row );
  682.               if i < j then
  683.                 Inc( i );
  684.             END;
  685.         end; // For Row
  686.       EndUpdate;
  687.       FreeMem( xi, PointMem );
  688.       DrawPoly( Numpoints, PolyPoints );
  689.     end;
  690. end;
  691.  
  692. Procedure FloodFill(X, Y: Integer; Border: Word);
  693. begin
  694. end;
  695.  
  696. Procedure GetArcCoords(var ArcCoords: ArcCoordsType);
  697. begin
  698.   If Assigned( BGI.DW ) then
  699.     With BGI.DW do
  700.       begin
  701.         ArcCoords.x := LastArc.x;
  702.         ArcCoords.y := LastArc.y;
  703.         ArcCoords.xStart := LastArc.xStart;
  704.         ArcCoords.yStart := LastArc.yStart;
  705.         ArcCoords.xEnd := LastArc.xEnd;
  706.         ArcCoords.yEnd := LastArc.yEnd;
  707.       end;
  708. end;
  709.  
  710. Procedure GetAspectRatio(var Xasp, Yasp: Word);
  711. begin
  712.   If Assigned( BGI.DW ) then
  713.     begin
  714.       XAsp := BGI.DW.XAspect;
  715.       yAsp := BGI.DW.YAspect;
  716.     end
  717.   else
  718.     begin
  719.       XAsp := 0;
  720.       yAsp := 0;
  721.     end
  722. end;
  723.  
  724. Function  GetBkColor: Word;
  725. begin
  726.   if Assigned( BGI.DW ) then
  727.     Result := BGI.DW.BkColor
  728.   else
  729.     Result := 0;
  730. end;
  731.  
  732. Function  GetColor: Word;
  733. begin
  734.   if Assigned( BGI.DW ) then
  735.     Result := BGI.DW.FgColor
  736.   else
  737.     Result := 0;
  738. end;
  739.  
  740. Procedure GetDefaultPalette(var Palette: PaletteType);
  741. var
  742.   i: Integer;
  743.  
  744. begin
  745.   If Assigned( BGI.DW ) then
  746.     with BGI.DW.PalInfo do
  747.       Case Size of
  748.         2   : Palette.Size := 2;
  749.         256 : Palette.Size := 256;
  750.       else    Palette.Size := 16;
  751.       end
  752.   else
  753.     Palette.Size := 256;
  754.  
  755.   With Palette do
  756.     begin
  757.       For i := 0 to Size-1 do
  758.         Colors[i] := i{+16;};
  759.       For i := Size to High(Colors) do
  760.         Colors[i] := 1;
  761.     end;
  762. end;
  763.  
  764. Function  GetDriverName: string;
  765. begin
  766.   Result := 'VP/2 DIVE VGA emulator';
  767. end;
  768.  
  769. Procedure GetFillPattern(var FillPattern: FillPatternType);
  770. begin
  771. end;
  772.  
  773. function GetGraphMode: Integer;
  774. begin
  775.   Result := 3;
  776. end;
  777.  
  778. Procedure GetFillSettings(var FillInfo: FillSettingsType);
  779. begin
  780.   if Assigned( BGI.DW ) then
  781.     FillInfo := BGI.DW.FillInfo
  782. end;
  783.  
  784. function  GetFrameRate: Double;  // Frames Per Second
  785. begin
  786.   if Assigned( BGI.DW ) then
  787.     GetFrameRate := BGI.DW.FrameRate
  788.   else
  789.     GetFrameRate := 0;
  790. end;
  791.  
  792. function  GetFrameTime: Double;  // Time (mSec) Per Frame
  793. begin
  794.   if Assigned( BGI.DW ) then
  795.     GetFrameTime := BGI.DW.FrameTime
  796.   else
  797.     GetFrameTime := 0;
  798. end;
  799.  
  800. procedure GetImage(x1, y1, x2, y2: Integer; var BitMap);
  801. var
  802.   p: Pchar;
  803.   y: Integer;
  804.   x: Integer;
  805. begin
  806.   x := x2-x1+1;
  807.   p := @BitMap;
  808.   pSmallWord(p)^ := x;
  809.   inc(p,sizeof(smallword));
  810.   pSmallWord(p)^ := y2-y1+1;
  811.   inc(p,sizeof(smallword));
  812.   pSmallWord(p)^ := 0;  // Reserved
  813.   inc(p,sizeof(smallword));
  814.   If assigned( BGI.DW ) then
  815.     with BGI.DW do
  816.       begin
  817.         VPTransformXYXY( x1, y1, x2, y2 );
  818.         BeginUpdate;
  819.         for y := y1 to y2 do
  820.           begin
  821.             move( DisplayBuffer^[ x1+y*xSize ], p^, x );
  822.             inc( p, x );
  823.           end;
  824.         EndUpdate;
  825.       end;
  826. end;
  827.  
  828. Procedure GetLineSettings(var LineInfo: LineSettingsType);
  829. begin
  830.   If assigned( BGI.DW ) then
  831.     begin
  832.       LineInfo := BGI.DW.LineInfo;
  833.     end;
  834. end;
  835.  
  836. Function  GetMaxColor: Word;
  837. begin
  838.   if Assigned( BGI.DW ) then
  839.     Result := BGI.DW.Colours-1;
  840. end;
  841.  
  842. Function  GetMaxX: Word;
  843. begin
  844.   if Assigned( BGI.DW ) then
  845.     Result := BGI.DW.xSize-1;
  846. end;
  847.  
  848. Function  GetMaxY: Word;
  849. begin
  850.   if Assigned( BGI.DW ) then
  851.     Result := BGI.DW.ySize-1;
  852. end;
  853.  
  854. Function  GetModeName(ModeNumber: Integer): string;
  855. begin
  856.   Result := 'VP/2 DIVE VGA';
  857. end;
  858.  
  859. Procedure GetPalette(var Palette: PaletteType);
  860. var
  861.   i : Integer;
  862.  
  863. begin
  864.   If assigned( BGI.DW ) then
  865.     with BGI.DW, Palette do
  866.       begin
  867.         Size := PalInfo.Size;
  868.         move( PalInfo.Colors, Colors, Sizeof( Colors ) );
  869.       end;
  870. end;
  871.  
  872. Function  GetPaletteSize: Integer;
  873. begin
  874.   If Assigned( BGI.DW ) then
  875.     Result := BGI.DW.PalInfo.Size
  876.   else
  877.     Result := 0;
  878. end;
  879.  
  880. Function  GetPixel(X,Y: Integer): Word;
  881. const
  882.   LastCol : Integer = 0;
  883. var
  884.   i: Integer;
  885.  
  886. begin
  887.   if Assigned( BGI.DW ) then
  888.     with BGI.DW, PalInfo do
  889.       begin
  890.         Result := Pixels[ x, y ];
  891.  
  892.         // First check if it is identical to the last one
  893.         if Colors[LastCol] = Result then
  894.           begin
  895.             Result := LastCol;
  896.             Exit;
  897.           end;
  898.  
  899.         for i := 0 to Size-1 do
  900.           If Colors[i] = Result then
  901.             begin
  902.               Result := i;
  903.               LastCol := i;
  904.               Exit;
  905.             end;
  906.       end;
  907.     Result := 0;
  908. end;
  909.  
  910. Procedure GetTextSettings(var TextInfo: TextSettingsType);
  911. begin
  912.   if assigned( BGI.DW ) then
  913.     with BGI.DW do
  914.       begin
  915.         TextInfo.Font := FntSel;
  916.         TextInfo.Direction := TxtDir;
  917.         TextInfo.CharSize := CharSz;
  918.         TextInfo.Horiz := TxtHoriz;
  919.         TextInfo.Vert := TxtVert;
  920.         TextInfo.userxscale := uSerxScale;
  921.         TextInfo.userYscale := uSerYScale;
  922.       end;
  923. end;
  924.  
  925. Procedure GetViewSettings(var ThisViewPort: ViewPortType);
  926. begin
  927.   If Assigned( BGI.DW ) then
  928.     with BGI.DW, ThisViewPort do
  929.       begin
  930.         x1 := ViewPort.x1;
  931.         x2 := ViewPort.x2;
  932.         y1 := ViewPort.y1;
  933.         y2 := ViewPort.y2;
  934.         Clip := VPClip;
  935.       end;
  936. end;
  937.  
  938. Function  GetX: Integer;
  939. begin
  940.   If Assigned( BGI.DW ) then
  941.     Result := BGI.DW.Position.x;
  942. end;
  943.  
  944. Function  GetY: Integer;
  945. begin
  946.   If Assigned( BGI.DW ) then
  947.     Result := BGI.DW.Position.y;
  948. end;
  949.  
  950. Procedure GraphDefaults;
  951. begin
  952.   if assigned( BGI.DW ) then
  953.    with BGI.DW do
  954.     begin
  955.     SetViewPort( 0, 0, xSize-1, ySize-1 );
  956.     FgColor := White;
  957.     BkColor := Black;
  958.     xScale := 1;
  959.     yScale := 1;
  960.     UserxScale := 1;
  961.     UseryScale := 1;
  962.     CharSz := 1;
  963.     TxtDir := 0;
  964.     TxtHoriz := LeftText;
  965.     TxtVert := TopText;
  966.     FntSel := DefaultFont;
  967.     PalInfo.Size := Colours;  // Ask DIVE for color count
  968.     GetDefaultPalette( PalInfo );
  969.     LineInfo.LineStyle := SolidLn;
  970.     LineInfo.Thickness := NormWidth;
  971.     LineInfo.Pattern := $FFFF;
  972.     FillInfo.Color:=White;
  973.     FillInfo.Pattern:= SolidFill;
  974.     SetLineThickness( LineInfo.Thickness );
  975.     xAspect := 10000;
  976.     yAspect := xAspect;  // Default 1:1 aspect ratio
  977.     WriteMode := NormalPut;
  978.   end;
  979. end;
  980.  
  981. Function  GraphErrorMsg(ErrorCode: Integer): String;
  982. begin
  983. end;
  984.  
  985. Function  GraphResult: Integer;
  986. begin
  987.   If Assigned(BGI.DW) then
  988.     Result := BGI.LastError
  989.   else
  990.     Result := grNoInitGraph;
  991. end;
  992.  
  993. function ImageSize(x1, y1, x2, y2: Integer): Word;
  994. begin
  995.   Result := (x2-x1+1)*(y2-y1+1)+6;
  996. end;
  997.  
  998. var
  999.   _KeyPressed: Longint;
  1000.   DelayCount: Longint;
  1001.  
  1002. const
  1003.   KeyCount: Integer = 0;                { Count of keys in KeyBuffer }
  1004.   CheckBreak: Boolean = True;               { Allow Ctrl-C for break? }
  1005.   _Shift: Integer = 0;
  1006.   _Ctrl: Integer = 0;
  1007.   _Alt: Integer = 0;
  1008. var
  1009.   KeyBuffer: array[0..63] of Char;      { Keyboard type-ahead buffer }
  1010.  
  1011. { Waits for next timer tick or delays 1ms }
  1012.  
  1013. function DelayLoop(Count: Longint; var StartValue: ULong): Longint;
  1014. var
  1015.   Value: ULong;
  1016. begin
  1017.   repeat
  1018.     DosQuerySysInfo(qsv_Ms_Count,qsv_Ms_Count,Value,SizeOf(Value));
  1019.     Dec(Count);
  1020.   until (Value <> StartValue) or (Count = -1);
  1021.   StartValue := Value;
  1022.   DelayLoop := Count;
  1023. end;
  1024.  
  1025. { Delays a specified number of milliseconds. DosSleep is too inexact on }
  1026. { small time intervals. More over, the least time interval for DosSleep }
  1027. { is 1 timer tick (usually 31ms). That is why for small time intervals  }
  1028. { special delay routine is used. Unfortunately, even this routine cannot}
  1029. { be exact in the multitasking environment.                             }
  1030.  
  1031. procedure Delay(MS: Longint);
  1032. var
  1033.   StartValue,Value: ULong;
  1034.   Count: Longint;
  1035. begin
  1036.   if (MS >= 31) or (Random>0.9) then DosSleep(MS)
  1037.  else
  1038.   begin
  1039.     DosQuerySysInfo(qsv_Ms_Count,qsv_Ms_Count,StartValue,SizeOf(StartValue));
  1040.     Value := StartValue;
  1041.     Count := MS;
  1042.     repeat
  1043.       DelayLoop(DelayCount,Value);
  1044.       Dec(Count)
  1045.     until (Value-StartValue >= MS) or (Count <= 0);
  1046.   end;
  1047. end;
  1048.  
  1049. { Calculates 1ms delay count for DelayLoop routine. }
  1050. { CalcDelayCount is called once at startup.         }
  1051.  
  1052. procedure CalcDelayCount;
  1053. var
  1054.   Interval,StartValue,Value: ULong;
  1055. begin
  1056.   DosQuerySysInfo(qsv_Timer_Interval,qsv_Timer_Interval,Interval,SizeOf(Interval));
  1057.   DosQuerySysInfo(qsv_Ms_Count,qsv_Ms_Count,StartValue,SizeOf(StartValue));
  1058.   repeat
  1059.     DosQuerySysInfo(qsv_Ms_Count,qsv_Ms_Count,Value,SizeOf(Value));
  1060.   until Value <> StartValue;
  1061.   DelayCount := -DelayLoop(-1,Value) div Interval * 10;
  1062.   if DelayCount = 0 then Inc(DelayCount);
  1063. end;
  1064.  
  1065. function AltPressed: Boolean;
  1066. begin
  1067.   Result := _Alt > 0;
  1068. end;
  1069.  
  1070. function ShiftPressed: Boolean;
  1071. begin
  1072.   Result := _Shift > 0;
  1073. end;
  1074.  
  1075. function CtrlPressed: Boolean;
  1076. begin
  1077.   Result := _Ctrl > 0;
  1078. end;
  1079.  
  1080. function KeyPressed: Boolean;
  1081. var
  1082.   m: qMsg;
  1083. begin
  1084.   KeyPressed := KeyCount > 0;
  1085.   If WaitKeypressed and ( KeyCount = 0 ) then
  1086.     DosSleep( 1 );
  1087. end;
  1088.  
  1089. function ReadKey: Char;
  1090. begin
  1091.   while not KeyPressed do
  1092.     ;
  1093.   ReadKey := KeyBuffer[0];
  1094.   Dec(KeyCount);
  1095.   Move(KeyBuffer[1], KeyBuffer[0], KeyCount);
  1096. end;
  1097.  
  1098. procedure WindowChar(Ch: Char);
  1099. begin
  1100.   if KeyCount < SizeOf(KeyBuffer) then
  1101.   begin
  1102.     KeyBuffer[KeyCount] := Ch;
  1103.     Inc(KeyCount);
  1104.   end;
  1105. end;
  1106.  
  1107. function MyMsgs( Wnd: HWnd; Msg: ULong; mp1, mp2: MParam ): MResult; cdecl;
  1108. var
  1109.   KeyUp: Boolean;
  1110. begin
  1111.   case msg of
  1112.     wm_char :
  1113.       begin
  1114.       KeyUp := (CharMsgMp1(Mp1).fs and kc_KeyUp) <> 0;
  1115.       if (CharMsgMp1(Mp1).fs and kc_VirtualKey) <> 0 then
  1116.         begin
  1117.           case CharMsgMp2(Mp2).VKey of
  1118.             vk_Shift : If KeyUp then
  1119.                 Dec( _Shift )
  1120.               else
  1121.                 if CharMsgMp1(Mp1).fs and kc_PrevDown = 0 then
  1122.                   Inc( _Shift );
  1123.             vk_Ctrl  : If KeyUp then
  1124.                 Dec( _Ctrl )
  1125.               else
  1126.                 if CharMsgMp1(Mp1).fs and kc_PrevDown = 0 then
  1127.                 Inc( _Ctrl );
  1128.             vk_Alt   : If KeyUp then
  1129.                 Dec( _Alt )
  1130.               else
  1131.                 if CharMsgMp1(Mp1).fs and kc_PrevDown = 0 then
  1132.                   Inc( _Alt );
  1133.             vk_ESC : If KeyUp then
  1134.               WindowChar( #27 );
  1135.           end;
  1136.         end;
  1137.       if not KeyUp then
  1138.       begin                                                     { Key is down }
  1139.         if CheckBreak then                                      { Break enabled }
  1140.           if (CharMsgMp2(Mp2).VKey = vk_Break) or               { Ctrl-Break }
  1141.             (((CharMsgMp1(Mp1).fs and kc_Ctrl) <> 0) and
  1142.              ((CharMsgMp2(Mp2).Chr = Ord('C')) or               { Ctrl-C }
  1143.               (CharMsgMp2(Mp2).Chr = Ord('c')))) then
  1144.                 Halt(255);{ Ctrl-c }
  1145.         if (CharMsgMp2(Mp2).Chr > 0) and (CharMsgMp2(Mp2).Chr <= 255) and
  1146.           ((CharMsgMp1(Mp1).fs and (kc_Ctrl + kc_Alt)) = 0)
  1147.           then
  1148.           begin
  1149.             WindowChar(Chr(CharMsgMp2(Mp2).Chr));
  1150.             Result := 1;
  1151.           end;
  1152. //          else WindowKeyDown(CharMsgMp2(Mp2).VKey, (CharMsgMp1(Mp1).fs and kc_Ctrl) <> 0);
  1153.         end;
  1154.       end;
  1155.   end;
  1156.   Result := 0;
  1157. end;
  1158.  
  1159. Function _InitGraph( p: Pointer ): Longint;
  1160. begin
  1161.   GrStatus := 0;
  1162.   _KeyPressed := 0;
  1163.   BGI.DW := tGraphWindow.Create( x_size, y_size, 8 , WindowTitle);
  1164.   if assigned( BGI.DW ) then
  1165.     with BGI, DW do
  1166.       try
  1167.         LastError := grOK;
  1168.         GrStatus := 1;
  1169.         MessageHandler := MyMsgs;
  1170.         Run;
  1171.       finally
  1172.         Destroy;
  1173.       end;
  1174.   BGI.DW := nil;
  1175.   GrStatus := 2;
  1176.   tidMessage := -1;
  1177. end;
  1178.  
  1179. procedure MyExitProc;
  1180. begin
  1181.   ExitProc := SaveExit;
  1182.   SaveExit := nil;
  1183.   CloseGraph;
  1184. end;
  1185.  
  1186. procedure InitGraph(var GraphDriver:Integer; var GraphMode: Integer;
  1187.     PathToDriver: string);
  1188.  
  1189. begin
  1190.   If GrStatus = 1 then
  1191.     Exit;  // Already running;
  1192.  
  1193.   tidMessage := VPBeginThread( _InitGraph, 4*16384, nil);
  1194.   if tidMessage <> 0 then
  1195.     begin
  1196.       While GrStatus = 0 do
  1197.         DosSleep( 50 );
  1198.       SaveExit := ExitProc;
  1199.       ExitProc := @MyExitProc;
  1200.  
  1201.       If GrStatus = 1 then
  1202.         begin
  1203.           GraphDriver := 9;    // VGA
  1204.           GraphMode   := 2;    // VGAHi
  1205.           BGI.PathToFont := PathToDriver;
  1206.           If BGI.PathToFont[Length(BGI.PathToFont)] <> '\' then
  1207.             BGI.PathToFont := BGI.PathToFont + '\';
  1208.           ClearViewPort;
  1209.           WaitDraw;
  1210.         end;
  1211.     end;
  1212. end;
  1213.  
  1214. Function  InstallUserFont(FontFileName: string) : Integer;
  1215. var
  1216.   i: Integer;
  1217.  
  1218. begin
  1219.   with BGI do
  1220.     if Fonts = MaxFonts then
  1221.       Result := -1
  1222.     else
  1223.       begin
  1224.         Inc( Fonts );
  1225.         with Font[ Fonts ] do
  1226.           begin
  1227.             FontName := FontFileName;
  1228.             Linked := False;
  1229.             CharData := nil;
  1230.           end;
  1231.  
  1232.         Result := Fonts;
  1233.       end;
  1234. end;
  1235.  
  1236. Procedure Line(X1, Y1, X2, Y2: Integer);
  1237. begin
  1238.   if Assigned( BGI.DW ) then
  1239.     With BGI.DW, LineInfo do
  1240.       begin
  1241.         BeginUpdate;
  1242.         if LineStyle = UserBitLn then
  1243.           SetLinePattern( Pattern )
  1244.         else
  1245.           SetLinePattern( LinePatterns[LineStyle] );
  1246.         SetLineThickness( LineInfo.Thickness );
  1247.         LinePutMode := WriteMode;
  1248.         DrawLine( x1, y1, x2, y2, FgColor );
  1249.         LinePutMode := NormalPut;
  1250.         SetLinePattern( $FFFFFFFF );
  1251.  
  1252.         EndUpdate;
  1253.       end;
  1254. end;
  1255.  
  1256. Procedure LineRel(Dx, Dy: Integer);
  1257. begin
  1258.   if Assigned( BGI.DW ) then
  1259.     With BGI.DW do
  1260.       begin
  1261.         BeginUpdate;
  1262.         LinePutMode := WriteMode;
  1263.         DrawLine( Position.x,    Position.y,
  1264.                   Position.x+Dx, Position.y+Dy, FgColor );
  1265.         LinePutMode := NormalPut;
  1266.         EndUpdate;
  1267.         Inc( Position.x, Dx );
  1268.         Inc( Position.y, Dy );
  1269.       end;
  1270. end;
  1271.  
  1272. Procedure LineTo(X, Y: Integer);
  1273. begin
  1274.   if Assigned( BGI.DW ) then
  1275.     With BGI.DW do
  1276.       begin
  1277.          BeginUpdate;
  1278.          LinePutMode := WriteMode;
  1279.          DrawLine( Position.x, Position.y, X, Y, FgColor );
  1280.          LinePutMode := NormalPut;
  1281.          EndUpdate;
  1282.          Position.x := x;
  1283.          Position.y := y;
  1284.        end;
  1285. end;
  1286.  
  1287. Procedure MoveRel(Dx, Dy: Integer);
  1288. begin
  1289.   if Assigned( BGI.DW ) then
  1290.     With BGI.DW do
  1291.       begin
  1292.         Inc( Position.x, Dx );
  1293.         Inc( Position.y, Dy );
  1294.       end;
  1295. end;
  1296.  
  1297. Procedure MoveTo(X, Y: Integer);
  1298. begin
  1299.   if Assigned( BGI.DW ) then
  1300.     With BGI.DW do
  1301.       begin
  1302.         Position.x := x;
  1303.         Position.y := y;
  1304.       end;
  1305. end;
  1306.  
  1307. procedure RotateXY( var x,y: Integer; Angle: Integer );
  1308. var
  1309.   x1, y1: Double;
  1310. begin
  1311.   While Angle < 0 do
  1312.     Inc( Angle, 360 );
  1313.   Angle := Angle mod 360;
  1314.   x1 := x;
  1315.   y1 := y;
  1316.   x := Round( x1*tcos[Angle*4] + y1*tsin[Angle*4] ) div 1024;
  1317.   y := Round( -x1*tsin[Angle*4] + y1*tcos[Angle*4] ) div 1024;
  1318. end;
  1319.  
  1320. procedure DrawBGIChar( var x,y: Integer; Ch: Char );
  1321.   procedure DecodeBGI( w: SmallWord; var x,y,Op: Integer );
  1322.   begin
  1323.     x  := w and $7F;
  1324.     if x and $40 <> 0 then
  1325.       x := x or $FFFFFF80;
  1326.     y  := (w shr 8) and $7F;
  1327.     if y and $40 <> 0 then
  1328.       y := y or $FFFFFF80;
  1329.     Op := byte(w) shr 7 or ((w shr 14) and 2);   // I think :)
  1330.   end;
  1331.  
  1332. const
  1333.   bgi_PenDone = 0;
  1334.   bgi_PenMove = 1;
  1335.   bgi_PenDraw = 3;
  1336.  
  1337. type
  1338.   psWord = ^SmallWord;
  1339.  
  1340. var
  1341.   ChOffs: Integer;
  1342.   ChPtr: Pchar;
  1343.   x1,y1,op: Integer;
  1344.   newx,newy: Integer;
  1345.   lastx,lasty: Integer;
  1346.  
  1347. begin
  1348.   With BGI.DW, BGI.Font[FntSel] do
  1349.     begin
  1350.       If ( Ch < FirstChar ) or ( Ch > LastChar ) then
  1351.         Exit;
  1352.  
  1353.       ChOffs := ord(ch)-ord(FirstChar);
  1354.       ChPtr := Ptr( Longint(CharData)+CharIndex[ChOffs] );
  1355.  
  1356.       DecodeBGI( psWord(ChPtr)^, x1, y1, Op );
  1357.       while Op <> bgi_PenDone do
  1358.         begin
  1359.           x1 := Round(x1 * xScale);
  1360.           y1 := Round(-y1 * yScale);
  1361.           RotateXY( x1, y1, TxtDir );
  1362.  
  1363.           if Op = bgi_PenMove then
  1364.             begin
  1365.               Lastx := x + x1;
  1366.               Lasty := y + y1;
  1367.             end
  1368.           else
  1369.             begin
  1370.               Newx := x + x1;
  1371.               Newy := y + y1;
  1372.               DrawLine( Lastx, Lasty, Newx, Newy, FgColor );
  1373.               Lastx := Newx;
  1374.               Lasty := Newy;
  1375.             end;
  1376.  
  1377.           Inc( ChPtr, Sizeof(SmallWord) );
  1378.           DecodeBGI( pWord(ChPtr)^, x1, y1, Op );
  1379.         end;
  1380.       x1 := Round(CharWidth[ChOffs] * xScale);
  1381.       y1 := 0;
  1382.       RotateXY( x1, y1, TxtDir );
  1383.       Inc( x, x1 );
  1384.       Inc( y, y1 );
  1385.     end;
  1386. end;
  1387.  
  1388. Procedure OutText(TextString: string);
  1389. var
  1390.   x,y: Integer;
  1391.   offx, offy: Integer;
  1392.   i: Integer;
  1393.  
  1394. begin
  1395.   If assigned( BGI.DW ) then
  1396.     with BGI, BGI.DW do
  1397.       begin
  1398.         x := Position.x;
  1399.         y := Position.y;
  1400.         Offx := 0;
  1401.         Offy := 0;
  1402.  
  1403.         If TxtHoriz = CenterText then
  1404.           Offx := -TextWidth( textString ) div 2
  1405.         else If TxtHoriz = RightText then
  1406.           Offx := -TextWidth( textString );
  1407.  
  1408.         If TxtVert = TopText then
  1409.           Offy := TextHeight(TextString)
  1410.         else if TxtVert = CenterText then
  1411.           Offy := TextHeight(TextString) div 2;
  1412.         RotateXY( Offx, Offy, TxtDir );
  1413.  
  1414.         Inc( x, Offx );
  1415.         SetLineThickness( 1 );
  1416.         If FntSel = DefaultFont then
  1417.           begin
  1418.             BeginUpdate;
  1419.             DrawStr( x,y, FgColor, BkColor, TextString );
  1420.             EndUpdate;
  1421. //            Inc( Position.x, Length(TextString)*8 );
  1422.           end
  1423.         else
  1424.           begin
  1425.             Inc( y, Offy );
  1426.             For i := 1 to Length( TextString ) do
  1427.               DrawBGIChar( x, y, TextString[i] );
  1428.           end;
  1429.         SetLineThickness( LineInfo.Thickness );
  1430.  
  1431.         // Finally adjust drawing position
  1432.         case TxtHoriz of
  1433.           LeftText: Offx := TextWidth( TextString );
  1434.           CenterText: Offx := TextWidth( TextString ) div 2;
  1435.           RightText: Offx := 0;
  1436.         end;
  1437.         Offy := 0;
  1438.         RotateXY( Offx, Offy, TxtDir );
  1439.  
  1440.         inc( Position.x, Offx );
  1441.         inc( Position.y, Offy );
  1442.       end;
  1443. end;
  1444.  
  1445. Procedure OutTextXY(X, Y: Integer; TextString: string);
  1446. Var
  1447.   OldPos : PointType;
  1448. begin
  1449.   With BGI, DW do
  1450.     If Assigned( DW ) and ( FntSel <> -1 ) then
  1451.       begin
  1452.         OldPos := Position;
  1453.         Position.x := x;
  1454.         Position.y := y;
  1455.         OutText( TextString );
  1456.  
  1457.         // Ignore position change
  1458.         Position := OldPos;
  1459.       end;
  1460. end;
  1461.  
  1462. Procedure PieSlice(X, Y: Integer; StAngle, EndAngle, Radius: Word);
  1463. begin
  1464.   If Assigned( BGI.DW ) then
  1465.     with BGI.DW do
  1466.       begin
  1467.         LineMode := False;
  1468.         Sector( x, y, StAngle, EndAngle, Radius, Radius );
  1469.       end;
  1470. end;
  1471.  
  1472. procedure PutImage(X, Y: Integer; var BitMap; BitBlt: Word);
  1473. var
  1474.   p: Pchar;
  1475.   width: Integer;
  1476.   height: Integer;
  1477.   i,j: Integer;
  1478.   inx, iny: Integer;
  1479.   Disp : ^Byte;
  1480. begin
  1481.   p := @BitMap;
  1482.   width  := pSmallWord(p)^;   inc(p,sizeof(smallword));
  1483.   height := pSmallWord(p)^;   inc(p,2*sizeof(smallword));
  1484.   If assigned( BGI.DW ) then
  1485.     with BGI.DW do
  1486.       begin
  1487.         inx := x;
  1488.         iny := y;
  1489.         VPTransformXY( x, y );
  1490.         BeginUpdate;
  1491.         for i := 0 to height-1 do
  1492.           begin
  1493.             if BitBlt < 0 then
  1494.               begin
  1495.                 move( p^, DisplayBuffer^[ x+(i+y)*xSize ], width );
  1496.                 inc( p, width );
  1497.               end
  1498.             else
  1499.               with PalInfo do
  1500.                 begin
  1501.                   Disp := @DisplayBuffer^[ x+(i+y)*xSize ];
  1502.                   for j := 1 to width do
  1503.                     begin
  1504.                     Case BitBlt of
  1505.                       CopyPut:Disp^ := ord(p^);
  1506.                       XORPut: Disp^ := ord(p^) xor Disp^;
  1507.                       ORPut:  Disp^ := ord(p^)  or Disp^;
  1508.                       ANDPut: Disp^ := ord(p^) and Disp^;
  1509.                       NOTPut: Disp^ := not ord(p^);
  1510.                     end;
  1511.                     inc(Disp);
  1512.                     Inc(p);
  1513.                   end;
  1514.                 end;
  1515.           end;
  1516.         EndUpdate;
  1517.         RectChanged( x, y, x+width-1, y+height-1 );
  1518.       end;
  1519. end;
  1520.  
  1521. Procedure PutPixel(X, Y: Integer; Color: Word);
  1522. begin
  1523.   if Assigned( BGI.DW ) then
  1524.     with BGI.DW, PalInfo do
  1525.       begin
  1526.         BeginUpdate;
  1527.         Pixels[ x, y ] := Colors[ Color ];
  1528.         EndUpdate;
  1529.       end;
  1530. end;
  1531.  
  1532. Procedure Rectangle(X1, Y1, X2, Y2: Integer);
  1533. begin
  1534.   if Assigned( BGI.DW ) then
  1535.     with BGI.DW do
  1536.       begin
  1537.         BeginUpdate;
  1538.         LineMode := True;
  1539.         LinePutMode := WriteMode;
  1540.         DrawBox( x1, y1, x2, y2, FgColor );
  1541.         LinePutMode := NormalPut;
  1542.         EndUpdate;
  1543.       end;
  1544. end;
  1545.  
  1546. Procedure RegisterBGIFont(FontID: Integer; Font: Pointer);
  1547. begin
  1548. end;
  1549.  
  1550. Procedure Sector(X, Y: Integer; StAngle, EndAngle, XRadius, YRadius: Word);
  1551. var
  1552.   Center: Pixel;
  1553.  
  1554. begin
  1555.   If Assigned( BGI.DW ) then
  1556.     with BGI.DW do
  1557.       begin
  1558.         BeginUpdate;
  1559.         StAngle := StAngle mod 360;
  1560.         If EndAngle <> 360 then
  1561.           EndAngle := EndAngle mod 360;
  1562.  
  1563.         Center.x := x;
  1564.         Center.y := y;
  1565.         DrawEllipse( Center, xRadius, YRadius, StAngle, EndAngle, FgColor );
  1566.         DrawLine( x,y, LastArc.xStart, LastArc.yStart, FgColor );
  1567.         DrawLine( x,y, LastArc.xEnd, LastArc.yEnd, FgColor );
  1568.         EndUpdate;
  1569.       end
  1570. end;
  1571.  
  1572. Procedure SetAllPalette(var Palette: PaletteType);
  1573. begin
  1574. end;
  1575.  
  1576. Procedure SetAspectRatio(Xasp, Yasp: Word);
  1577. begin
  1578.   If Assigned( BGI.DW ) then
  1579.     with BGI.DW do
  1580.       begin
  1581.         XAspect := XAsp;
  1582.         yAspect := YAsp;
  1583.       end
  1584. end;
  1585.  
  1586. Procedure SetBkColor(ColorNum: Word);
  1587. begin
  1588.   if Assigned( BGI.DW ) then
  1589.     BGI.DW.BkColor := ColorNum;
  1590. end;
  1591.  
  1592. Procedure SetColor(Color: Word);
  1593. begin
  1594.   if Assigned( BGI.DW ) then
  1595.     BGI.DW.FgColor := Color;
  1596. end;
  1597.  
  1598. Procedure SetFillPattern(Pattern: FillPatternType; Color: Word);
  1599. var
  1600.   i: Integer;
  1601. begin
  1602.   if Assigned( BGI.DW ) then
  1603.     with BGI.DW do
  1604.       begin
  1605.         FillInfo.Pattern := UserFill;
  1606.         FillInfo.Color := Color;
  1607.         for i := 1 to 8 do
  1608.           begin
  1609.             // Expand 8x8 to 16x16 matrix
  1610.             FillPattern[ (i-1)   ] := Pattern[i] or Pattern[i] shl 8;
  1611.             FillPattern[ (i-1)+8 ] := FillPattern[ i-1 ];
  1612.           end;
  1613.         FillColor := Color;
  1614.       end;
  1615. end;
  1616.  
  1617. Procedure SetWideFillPattern(Pattern: NewPatternType; Color: Word);
  1618. var
  1619.   i: Integer;
  1620. begin
  1621.   if Assigned( BGI.DW ) then
  1622.     with BGI.DW do
  1623.       begin
  1624.         FillInfo.Pattern := UserFill;
  1625.         FillInfo.Color := Color;
  1626.         move( Pattern, FillPattern, Sizeof( FillPattern ) );
  1627.         FillColor := Color;
  1628.       end;
  1629. end;
  1630.  
  1631. Procedure SetFillStyle(Pattern: Word; Color: Word);
  1632. const
  1633.   AllPatterns : ARRAY [0..11] OF NewPatternType =
  1634.   (($0000,$0000,$0000,$0000,$0000,$0000,$0000,$0000,
  1635.     $0000,$0000,$0000,$0000,$0000,$0000,$0000,$0000),
  1636.    ($FFFF,$FFFF,$FFFF,$FFFF,$FFFF,$FFFF,$FFFF,$FFFF,
  1637.     $FFFF,$FFFF,$FFFF,$FFFF,$FFFF,$FFFF,$FFFF,$FFFF),
  1638.    ($0000,$0000,$0000,$FFFF,$0000,$0000,$0000,$0000,
  1639.     $0000,$0000,$0000,$FFFF,$0000,$0000,$0000,$0000),
  1640.    ($0001,$0002,$0004,$0008,$0010,$0020,$0040,$0080,
  1641.     $0100,$0200,$0400,$0800,$1000,$2000,$4000,$8000),
  1642.    ($0303,$0606,$0C0C,$1818,$3030,$6060,$C0C0,$8181,
  1643.     $0303,$0606,$0C0C,$1818,$3030,$6060,$C0C0,$8181),
  1644.    ($8181,$C0C0,$6060,$3030,$1818,$0C0C,$0606,$0303,
  1645.     $8181,$C0C0,$6060,$3030,$1818,$0C0C,$0606,$0303),
  1646.    ($8000,$4000,$2000,$1000,$0800,$0400,$0200,$0100,
  1647.     $0080,$0040,$0020,$0010,$0008,$0004,$0002,$0001),
  1648.    ($0808,$0808,$0808,$FFFF,$0808,$0808,$0808,$0808,
  1649.     $0808,$0808,$0808,$FFFF,$0808,$0808,$0808,$0808),
  1650.    ($8002,$4004,$2008,$1010,$0820,$0440,$0280,$0100,
  1651.     $0280,$0440,$0820,$1010,$2008,$4004,$8002,$0001),
  1652.    ($8282,$4444,$2828,$1010,$2828,$4444,$8282,$0101,
  1653.     $8282,$4444,$2828,$1010,$2828,$4444,$8282,$0101),
  1654.    ($0000,$0800,$0000,$0000,$0000,$0000,$0000,$0000,
  1655.     $0000,$0010,$0000,$0000,$0000,$0000,$0000,$0000),
  1656.    ($0000,$4444,$0000,$0000,$0000,$2222,$0000,$0000,
  1657.     $0000,$4444,$0000,$0000,$0000,$2222,$0000,$0000));
  1658. begin
  1659.   if Assigned( BGI.DW ) then
  1660.     with BGI.DW do
  1661.       begin
  1662.         If Pattern > High( AllPatterns ) then
  1663.           Pattern := SolidFill;
  1664.         FillInfo.Pattern := Pattern;
  1665.         FillInfo.Color := Color;
  1666.         move( AllPatterns[Pattern], FillPattern, Sizeof( FillPattern ) );
  1667.         FillColor := Color;
  1668.       end;
  1669. end;
  1670.  
  1671. Procedure SetLineStyle(LineStyle: Word; Pattern: Word; Thickness: Word);
  1672. begin
  1673.   If Assigned( BGI.DW ) then
  1674.     with BGI.DW do
  1675.       begin
  1676.         LineInfo.Thickness := ThickNess;
  1677.         LineInfo.Pattern := Pattern or (Pattern shl 16);
  1678.         LineInfo.LineStyle := LineStyle;
  1679.         SetLineThickness( LineInfo.Thickness );
  1680.         if LineStyle = UserBitLn then
  1681.           SetLinePattern( Pattern )
  1682.         else
  1683.           SetLinePattern( LinePatterns[LineStyle] );
  1684.       end;
  1685. end;
  1686.  
  1687. Procedure SetPalette(ColorNum: Word; Color: Byte);
  1688. begin
  1689. end;
  1690.  
  1691. Procedure SetRGBPalette(ColorNum: Word; Red, Green, Blue: Byte);
  1692. begin
  1693.   If Assigned( BGI.DW ) then
  1694.     begin
  1695.       with BGI.DW do
  1696.         SetRGBColor( ColorNum, Red, Green, Blue );
  1697. //        DosSleep(1);
  1698.     end;
  1699. end;
  1700.  
  1701. Procedure SetTextJustify(Horiz, Vert: Word);
  1702. begin
  1703.   with BGI, DW do
  1704.     begin
  1705.       if not assigned( DW ) or ( FntSel = -1 ) then
  1706.         Exit;
  1707.       If ( Horiz < LeftText ) or ( Horiz > RightText ) or
  1708.          ( Vert < BottomText ) or ( Vert > TopText ) then
  1709.         Exit;
  1710.  
  1711.       TxtHoriz := Horiz;
  1712.       TxtVert  := Vert;
  1713.     end;
  1714. end;
  1715.  
  1716. procedure UnloadFont( Font: Integer );
  1717. begin
  1718.   if Font > DefaultFont then
  1719.     With BGI.Font[Font] do
  1720.       If ( ChDataMem > 0 ) and ( CharData <> nil ) then
  1721.         begin
  1722.           FreeMem( CharData, ChDataMem );
  1723.           CharData := nil;
  1724.         end;
  1725. end;
  1726.  
  1727. function LoadFont( Font: Integer ): Boolean;
  1728. const
  1729.   Ext: Array[1..3] of str4 = ('','.CHR','.BGI');
  1730. var
  1731.   f: File;
  1732.   Buf: Array[1..16] of char;
  1733.   Err: Integer;
  1734.   i: Integer;
  1735.   Path: Integer;
  1736.   fName : String;
  1737.  
  1738. begin
  1739.   LoadFont := False;
  1740.  
  1741.   Path := 1;
  1742.   Repeat
  1743.     i := Low(Ext);
  1744.     Repeat
  1745.       fName := BGI.Font[Font].FontName+Ext[i];
  1746.       If Path = 1 then
  1747.         fName := BGI.PathToFont + fName;
  1748.       if fName <> '' then
  1749.         begin
  1750.           Assign( f, fName );
  1751.           {$I-}
  1752.           reset(f, 1);
  1753.           {$I+}
  1754.         end;
  1755.       inc(i);
  1756.     Until ((IOResult = 0) and (fName <> '')) or (i>High(Ext));
  1757.     Inc( Path );
  1758.   Until ( Path > 2 ) or ( i <= High(Ext) );
  1759.   BGI.LastError := GrInvalidFont;
  1760.   If i <= High(Ext) then
  1761.     try
  1762.       BlockRead( f, Buf, 2, Err );
  1763.       If ( Buf[1] <> 'P' ) or ( Buf[2] <> 'K' ) then
  1764.         Exit;
  1765.  
  1766.       Seek( f, $80 );
  1767.       BlockRead( f, Buf, 16, Err );
  1768.       If (Buf[1] <> '+') or (err <> 16) then
  1769.         Exit;
  1770.  
  1771.       BGI.LastError := grOK;
  1772.       with BGI.Font[Font] do
  1773.         begin
  1774.           FirstChar := Buf[5];
  1775.           Chars := ord(Buf[2]);
  1776.           LastChar  := Chr( ord(FirstChar)+Chars-1 );
  1777.           Org_To_Top := ord(buf[9]);
  1778.           Org_To_Base:= ord(buf[10]);
  1779.           Org_To_Dec := ord(buf[11]);
  1780.           if Org_To_Dec and $80 > 0 then
  1781.             Org_To_Dec := Org_To_Dec or $FF00;
  1782.  
  1783.           BlockRead( f, CharIndex, Chars*2, Err );
  1784.           BlockRead( f, CharWidth, Chars, Err );
  1785.           ChDataMem := FileSize(f)-filePos(f);
  1786.           GetMem( CharData, ChDataMem );
  1787.           BlockRead( f, CharData^, ChDataMem, Err );
  1788.           Linked := True;
  1789.         end;
  1790.       Result := True;
  1791.     finally
  1792.       close(f);
  1793.     end;
  1794. end;
  1795.  
  1796. Procedure SetTextStyle(Font, Direction, CharSize: Integer);
  1797. begin
  1798.   If assigned( BGI.DW ) then
  1799.     with BGI.DW do
  1800.       begin
  1801.         If Font <> FntSel then
  1802.           begin
  1803.             UnloadFont( FntSel );
  1804.             If (Font = DefaultFont) or LoadFont( Font ) then
  1805.               begin
  1806.                 FntSel := Font;
  1807.               end
  1808.             else
  1809.               begin
  1810.                 Raise EGraph.CreateFmt(
  1811.                   'Font %d (%s) could not be found!', [FntSel, BGI.Font[FntSel].FontName] );
  1812.                 FntSel := -1;
  1813.                 Exit;
  1814.               end;
  1815.           end;
  1816.         If CharSize > 10 then CharSize := 10;
  1817.         If CharSize = 0 then
  1818.           begin
  1819.             xScale := UserxScale;
  1820.             yScale := UseryScale;
  1821.           end
  1822.         else
  1823.           if CharSize > 0 then
  1824.             begin
  1825.               xScale := FontScale[ CharSize ];
  1826.               yScale := FontScale[ CharSize ];
  1827.             end
  1828.           else
  1829.             begin // CharSize < 0
  1830.               xScale := Abs(CharSize) / FontScale[ CharSize ];
  1831.               yScale := xScale;
  1832.             end;
  1833.         CharSz := CharSize;
  1834.         TxtDir := Direction;
  1835.       end;
  1836. end;
  1837.  
  1838. Procedure SetUserCharSize(MultX, DivX, MultY, DivY: Word);
  1839. begin
  1840.   with BGI, DW do
  1841.     begin
  1842.       if not assigned( DW ) or ( FntSel = -1 ) then
  1843.         Exit;
  1844.       If ( DivX = 0 ) or ( DivY = 0 ) then
  1845.         Exit;
  1846.  
  1847.       UserxScale := MultX / DivX;
  1848.       UseryScale := MultY / DivY;
  1849.       If CharSz = 0 then
  1850.         begin
  1851.           xScale := UserxScale;
  1852.           yScale := UseryScale;
  1853.         end;
  1854.     end;
  1855. end;
  1856.  
  1857. Procedure SetViewPort(X1, Y1, X2, Y2: Integer; Clip: Boolean);
  1858. begin
  1859.   If Assigned( BGI.DW ) then
  1860.     if ( x1 < 0 ) or ( x2 < x1 ) or
  1861.        ( y1 < 0 ) or ( y2 < y1 ) then
  1862.       BGI.LastError := grError
  1863.     else
  1864.       With BGI.DW do
  1865.         begin
  1866.           SetViewPort( x1,y1, x2,y2 );
  1867.           VPClip := Clip;
  1868.           Position.x := 0;
  1869.           Position.y := 0;
  1870.         end;
  1871. end;
  1872.  
  1873. Procedure SetWriteMode(WriteMode: Integer);
  1874. begin
  1875.   If Assigned( BGI.DW ) then
  1876.     if WriteMode in [0..4] then
  1877.       BGI.DW.WriteMode := WriteMode;
  1878. end;
  1879.  
  1880. Function  TextHeight(TextString: string): Word;
  1881. begin
  1882.   With BGI, DW do
  1883.     If FntSel = DefaultFont then
  1884.       Result := 8
  1885.     else
  1886.       with Font[ FntSel ] do
  1887.         Result := round(( Org_to_Top - Org_To_Dec ) * Yscale);
  1888. end;
  1889.  
  1890. Function  TextWidth(TextString: string): Word;
  1891. var
  1892.   ChOffs : Integer;
  1893.   i: Integer;
  1894.  
  1895. begin
  1896.   Result := 0;
  1897.   If not assigned( BGI.DW ) or ( BGI.DW.FntSel = -1 ) then
  1898.     Exit;
  1899.  
  1900.   with BGI.DW do
  1901.     begin
  1902.       If FntSel = DefaultFont then
  1903.         begin
  1904.           Result := 8*Length(TextString);
  1905.           Exit;
  1906.         end;
  1907.       with BGI.Font[ FntSel ] do
  1908.         for i := 1 to Length( TextString ) do
  1909.           begin
  1910.             ChOffs := ord(TextString[i]) - ord(FirstChar);
  1911.             If ( ChOffs >= 0 ) and ( ChOffs < Chars ) then
  1912.               Inc( Result, CharWidth[ChOffs] );
  1913.           end;
  1914.     end;
  1915.   Result := Round( Result * BGI.DW.xScale );
  1916. end;
  1917.  
  1918. procedure WaitDraw;
  1919. begin
  1920.   If Assigned( BGI.DW ) then
  1921.     BGI.DW.WaitDraw;
  1922. end;
  1923.  
  1924. procedure SuspendRefresh;   // Suspend refreshing of screen
  1925. begin
  1926.   If Assigned( BGI.DW ) then
  1927.     BGI.DW.PauseDisplay := True;
  1928. end;
  1929.  
  1930. procedure EnableRefresh;    // Enable refreshing of screen
  1931. begin
  1932.   If Assigned( BGI.DW ) then
  1933.     BGI.DW.PauseDisplay := False;
  1934. end;
  1935.  
  1936. procedure AcceleratedBlit;  // Enable faster blitting routine (Only updated DIVE.DLL)
  1937. begin
  1938.   If Assigned( BGI.DW ) then
  1939.     BGI.DW.FastBlit := True;
  1940. end;
  1941.  
  1942. procedure SlowBlit;         // Enable slow blitting routine
  1943. begin
  1944.   If Assigned( BGI.DW ) then
  1945.     BGI.DW.FastBlit := False;
  1946. end;
  1947.  
  1948. var
  1949.   i: Integer;
  1950.  
  1951. initialization
  1952.   BGI.DW := nil;
  1953.   BGI.Fonts := High(FontNames);
  1954.   for i := Low(FontNames) to High(FontNames) do
  1955.     with BGI.Font[i] do
  1956.       begin
  1957.         FontName := FontNames[i];
  1958.         Linked := false;
  1959.       end;
  1960.   BGI.LastError := grOK;
  1961.   GrStatus := 0;
  1962.   CalcDelayCount;
  1963.   SaveExit := nil;
  1964.   tidMessage := -1;
  1965. end.
  1966.  
  1967.