function isTrueType(FontName: string): byte; 
var 
  cnv: TCanvas; 
  tm: TTextMetric; 
begin 
  cnv := TCanvas.Create; 
  try 
    cnv.Handle := CreateCompatibleDC(0); 
    cnv.Font.Name := FontName; 
    GetTextMetrics(cnv.Handle, tm); 
    Result := ord(tm.tmPitchAndFamily and TMPF_TRUETYPE <> 0); 
  except 
    Result := 2; 
  end; 
  cnv.Free; 
end; 
 
// Beispiel 
 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  case isTrueType(Self.Font.Name) of 
    0: showmessage('FIXED'); 
    1: showmessage('TrueType'); 
  else showmessage('FEHLER'); 
  end; 
end;