{~ Shows a named Borlan Turbo Pascal font ~}

program showfont; {shows a named Borland Turbo Pascal font}
      {by Jan Hollan, when learning using fonts;
       edited from a Czech source code by Ondrej Cada
       that came to me in a package containing *.chr
       with accented Czech letters in Kamenicky's code table}

uses crt, graph, dos,
     G_scree; {J.H's unit, for hardcopies}


procedure testgrapherror;
var  i : integer;
begin
  i:=graphresult;
  if i<>grOk then begin
    closegraph;  
    writeln('Graphic driver error: ',grapherrormsg(i));
    halt(0);
  end
end;

{ main programme }

var
  pathtodriver,cf,th,si : string;
  fname: array [1 .. 20] of string;
  gd,gm,font,Y,size : integer;
  j,h:byte;
  c:char;


begin
if paramcount<1 then begin writeln(
'Give me a name of the Turbo Pascal font file (without the .chr suffix),',#13#10,
' I will show it to you (if the BGI env. variable says the needed directory).');
                halt end;
  pathtodriver:=getenv('BGI');
  Y:=0;
    detectgraph(gd,gm);
    initgraph(gd,gm,pathtodriver);
    testgrapherror;
  for j:= 1 to paramcount do
 begin
    fname[j]:=paramstr(j);
    font:=installuserfont(fname[j]);
                 { instalation of demanded fontu }
    testgrapherror;
    settextstyle(font,0,10);
    str(font:2,cf);
    H:=textheight('font No.'+cf);
    size:= 13000 div h;
    setusercharsize(size,100,size,100);
    H:=textheight('font No.'+cf);
    testgrapherror;
    str(size:4,si);
    inc(Y,round(H*1.2));
    MoveTo(20,Y);
    str(H:2,th);
    outtext('font'+cf+' '+fname[j]+' size'+si+'/100, '+th+' high');
 end;
 repeat until keypressed;
 c:=readkey;
 if c=#0 then
  begin
   c:=readkey;
   if c=#114 then begin PriGScrC; closegraph; halt end;
  end;
 closegraph
end.