home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1998 April A / Pcwk4a98.iso / PROGRAM / DELPHI16 / Disp3d / GRAF.PAS < prev    next >
Pascal/Delphi Source File  |  1995-05-14  |  2KB  |  104 lines
  1. unit graf;
  2. interface
  3. uses graph,mouse;
  4.  
  5. procedure StartGraph(Tall:word);
  6. procedure EndGraph;
  7. FUNCTION LoadFont(FontName:STRING):INTEGER;
  8.  
  9. const GraphOn : boolean = false;
  10.       Mode : integer = 0;
  11.       MyFont : word = 0;
  12.  
  13. var   gd,gm : integer;
  14. var   Result:integer;
  15.  
  16. implementation
  17.  
  18. function AutoDet:integer; far;
  19. begin
  20.   AutoDet := Mode;
  21. end;
  22.  
  23. procedure BGI256Proc; external;
  24. {$L BGI256.OBJ}
  25.  
  26. procedure SmallFontProc; external;
  27. {$L LITT.OBJ}
  28.  
  29. {------------------------------------------------}
  30. procedure StartGraph(Tall:word);
  31. var Err:integer;
  32. begin
  33.   if not GraphOn then
  34.  
  35.  
  36.     GraphOn := false;
  37.     case Tall of
  38.      0..200 : Mode := 0;
  39.      201..480 : Mode := 2;
  40.      481..600: Mode := 3;
  41.      else Mode := 3;
  42.     end;
  43.     gm := mode;
  44.     gd := InstallUserDriver('BGI256',@AutoDet);
  45.     Result := RegisterBGIDriver(@BGI256Proc);
  46.  
  47.     gd := 0;
  48.     InitGraph(gd,gm,'');
  49.     Err := GraphResult;
  50.     if Err <> 0 then
  51.     begin
  52.       writeln('Eek! no graphics! ',GraphErrorMsg(Err));
  53.       halt(1);
  54.     end;
  55.     GraphOn := true;
  56. end;
  57.  
  58. procedure EndGraph;
  59. begin
  60.   HideMouse;
  61.   if GraphOn then
  62.     CloseGraph;
  63. end;
  64.  
  65. {$I-}
  66. FUNCTION LoadFont(FontName:STRING):INTEGER;
  67. VAR FontF: file;
  68.     FontP: pointer;
  69.     FontNumber : integer;
  70. BEGIN
  71.   if FontName <> 'LITT.CHR' then
  72.   begin
  73.     FontNumber := InstallUserFont(FontName);   { Install the font }
  74.     IF GraphResult <> grOk THEN
  75.     BEGIN
  76.       Writeln('Error installing ',FontName,' (using DefaultFont)');
  77.       Exit;
  78.     END;
  79.  
  80.     Assign(FontF, FontName);
  81.     Reset(FontF, 1);
  82.     GetMem(FontP, FileSize(FontF));
  83.     BlockRead(FontF,FontP^,FileSize(FontF));
  84.     CLOSE(FontF);
  85.   end
  86.   else
  87.   begin
  88.     FontP := @SmallFontProc;
  89.   end;
  90.  
  91.   FontNumber := RegisterBGIfont(FontP);
  92.   LoadFont := FontNumber;
  93.   IF FontNumber < 0 THEN
  94.   BEGIN
  95.     WriteLn('Error registering font: ',FontName,' (',
  96.             GraphErrorMsg(GraphResult),')');
  97.     LoadFont := 0;
  98.   END;
  99.  
  100. END;
  101.  
  102.  
  103. end.
  104.