function IsFontHaveRussianGlifs(AFont: TFont): Boolean; overload;
 function IsFontHaveRussianGlifs(AFontName: string): Boolean; overload;

var
 Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.btn1Click(Sender: TObject);

 function CheckFont(AFontName: string): string;
 const
   Arr: array [Boolean] of string = ('НЕ ', '');
 begin
   Result := Format('Шрифт \"%s\" %sподдерживает русскую кодировку', [AFontName, Arr[IsFontHaveRussianGlifs(AFontName)]]);
 end;

begin
 Caption := CheckFont('EanP36Tt') + ' ||| ' + CheckFont('Arial')
end;

function IsFontHaveRussianGlifs(AFontName: string): Boolean;
var
 F: TFont;
begin
 F := TFont.Create;
 try
   F.Name := AFontName;
   Result := IsFontHaveRussianGlifs(F);
 finally
   F.Free;
 end;
end;

function IsFontHaveRussianGlifs(AFont: TFont): Boolean;
var
 b: Byte;
 DC: HDC;
 oldFont: HFONT;
 Res: Cardinal;
begin
 DC := GetDC(0);
 oldFont := SelectObject(DC, AFont.Handle);
 try
   Res := GetGlyphIndicesA(DC, 'Ж', 1, @b, GGI_MARK_NONEXISTING_GLYPHS);
   Result := Res <> GDI_ERROR;
   Result := Result and (b <> 255);
 finally
   SelectObject(DC, oldFont);
 end;
end;

 Result := Res <> GDI_ERROR;

 Result := Res = 1;