Delphi Tesseract wrapper无法获取字体名称问题求助

问题原因 #

你当前使用的TTesseractOCR4封装库中，TTesseractWord.FontName属性未被正确填充——封装库生成PageLayout.Words列表的逻辑里，没有调用Tesseract原生API的WordFontAttributes方法提取字体信息。

解决方案 #

方案1：直接调用原生迭代器API获取字体信息 #

绕过封装库的Words列表，手动通过ResultIterator遍历单词并提取字体属性，代码示例：

procedure TForm1.TesseractRecognizeEnd(Sender: TObject);
var
  Iterator: PResultIterator;
  FontName: PAnsiChar;
  FontSize: Integer;
  IsBold, IsItalic, IsUnderlined, IsMonospace, IsSerif, IsSmallcaps: Boolean;
  HasFontInfo: Boolean;
  WordText: PAnsiChar;
begin
  Tesseract.PageLayout.AnalyseLayout;
  // 获取原生ResultIterator指针（若封装库未暴露此属性，需手动扩展）
  Iterator := Tesseract.PageLayout.LayoutIterator;

  if Assigned(Iterator) then
  begin
    // 从单词级别开始遍历
    Iterator^.Begin(Iterator, RIL_WORD);
    repeat
      // 获取单词文本
      WordText := Iterator^.GetUTF8Text(Iterator, RIL_WORD);
      if Assigned(WordText) then
      begin
        Memo1.Lines.Add(UTF8ToString(WordText));
        Iterator^.DeleteText(Iterator, RIL_WORD); // 释放文本内存
      end;

      // 获取字体属性
      HasFontInfo := Iterator^.WordFontAttributes(Iterator, @FontName, @FontSize,
        @IsBold, @IsItalic, @IsUnderlined, @IsMonospace, @IsSerif, @IsSmallcaps);
      
      if HasFontInfo and Assigned(FontName) then
        Memo1.Lines.Add(UTF8ToString(FontName))
      else
        Memo1.Lines.Add('无法获取字体信息');

    until not Iterator^.Next(Iterator, RIL_WORD);
  end;
end;

补充说明：

• 若封装库未暴露LayoutIterator属性，需修改TTesseractPageLayout类添加封装：

  type
    TTesseractPageLayout = class
    private
      FHandle: PPageIterator;
      // ... 现有代码
    public
      property LayoutIterator: PResultIterator read GetLayoutIterator;
      // ... 现有代码
    end;
  
    // 实现属性方法
    function TTesseractPageLayout.GetLayoutIterator: PResultIterator;
    begin
      Result := TesseractAPI.PageIteratorGetResultIterator(FHandle);
    end;
  

• 初始化Tesseract时建议添加字体分析配置：

  Tesseract.SetVariable('textord_old_xheight', '1');
  

方案2：修改封装库完善FontName属性填充 #

若希望继续使用PageLayout.Words列表，可修改封装库生成TTesseractWord的逻辑，添加字体信息提取：

找到TTesseractPageLayout类中生成单词列表的代码，补充以下逻辑：

// 假设原代码中有遍历单词并创建TTesseractWord的片段
while Iterator^.Next(Iterator, RIL_WORD) do
begin
  Word := TTesseractWord.Create;
  try
    Word.Text := UTF8ToString(Iterator^.GetUTF8Text(Iterator, RIL_WORD));
    Iterator^.DeleteText(Iterator, RIL_WORD);

    // 新增：提取字体名称
    var FontName: PAnsiChar;
    var FontSize: Integer;
    var IsBold, IsItalic, IsUnderlined, IsMonospace, IsSerif, IsSmallcaps: Boolean;
    if Iterator^.WordFontAttributes(Iterator, @FontName, @FontSize, @IsBold, @IsItalic, @IsUnderlined, @IsMonospace, @IsSerif, @IsSmallcaps) then
      Word.FontName := UTF8ToString(FontName);

    FWords.Add(Word);
  except
    Word.Free;
    raise;
  end;
end;

重新编译封装库后，即可在原有代码中正常获取FontName值。

内容的提问来源于stack exchange，提问作者Rati2019