像 Delphi 上的 MS Word 一样的字数统计

Question

您能解释一下如何在 TMemo 中计算单词数并在 TLabet 或 TEdit 中显示结果吗？ 是否可以？我还想知道如何计算相似单词（重复单词）的数量。谢谢。 PS：如何找到文本中的单词密度？例如：“狗”这个词在文中出现了3次。文本的字数为100。因此“狗”一词的密度为3%。 （3/100 * 100%）。

Answer 1

对于第一部分（使用字符），

function CountWordsInMemo(AMemo: TMemo): integer;
var
  i: Integer;
  IsWhite, IsWhiteOld: boolean;
  txt: string;
begin
  txt := AMemo.Text;
  IsWhiteOld := true;
  result := 0;
  for i := 1 to length(txt) do
  begin
    IsWhite := IsWhiteSpace(txt[i]);
    if IsWhiteOld and not IsWhite then
      inc(result);
    IsWhiteOld := IsWhite;
  end;
end;

对于第二部分，

function OccurrencesOfWordInMemo(AMemo: TMemo; const AWord: string): integer;
var
  LastPos: integer;
  len: integer;
  txt: string;
begin
  txt := AMemo.Text;
  result := 0;
  LastPos := 0;
  len := Length(AWord);
  repeat
    LastPos := PosEx(AWord, txt, LastPos + 1);
    if (LastPos > 0) and
      ((LastPos = 1) or not IsLetter(txt[LastPos-1])) and
      ((LastPos + len - 1 = length(txt)) or not IsLetter(txt[LastPos+len])) then
      inc(result);
  until LastPos = 0;
end;

function DensityOfWordInMemo(AMemo: TMemo; const AWord: string): real;
begin
  result := OccurrencesOfWordInMemo(AMemo, AWord) / CountWordsInMemo(AMemo);
end;

Answer 2

maXbox4 有一个更简单、更快、更好的功能：

{ Returns a count of the number of occurences of SubText in Text }
function CountOccurences( const SubText: string;
                             const Text: string): Integer;
begin
  Result:= Pos(SubText, Text); 
  if Result > 0 then
    Result:= (Length(Text)-Length(StringReplace(Text,SubText,'',
                                     [rfReplaceAll]))) div  Length(subtext);
end;  { CountOccurences }

println('keyword freq. '+itoa(CountOccurences('exit',memo1.text)));