Форум: "Основная";
Текущий архив: 2002.04.11;
Скачать: [xml.tar.bz2];

Вниз

Строки   Найти похожие ветки 

← →
lipskiy   (2002-04-01 00:02) [3]

Взял из свой программки.
Считает в Мемо число слов, слогов, символов и время в секундах, необходимое для произнесения текста вслух (из утилитки для рекламных агентств - просчитывать текст рекламных роликов).
Писалась с лету за пару часов, поэтому может быть неоптимальной.

procedure TForm1.Calculation;
var i,j,t:integer;
bs,word:string;
Letter:boolean;
MaxLetter:integer;
CurLetter:integer;
Slog:integer;
AllLet:integer;
ActMem:TMemo;
begin
case PageControl1.ActivePageIndex of
0: ActMem:= Memo1;
1: ActMem:= MemoClip;
end;
if ActMem = nil then exit;

CntWord:=0;
MaxLetter:=0;
CurLetter:=0;
Slog:=0;
AllLet:=0;
word:="";

for i:= 0 to ActMem.Lines.Count-1 do
begin
bs:= ActMem.Lines[i];
for j:=1 to length(bs) do
if bs[j] = " " then
begin
inc(AllLet);
if Letter then if
(word <> "-") and
(word <> ".") and
(word <> ",") and
(word <> "?") and
(word <> "!") and
(word <> ":") and
(word <> ";") and
(word <> "(") and
(word <> ")")
then inc(CntWord);
Letter:=false;
if CurLetter>MaxLetter then MaxLetter:=CurLetter;
CurLetter:=0;
word:="";
end
else
begin
inc(AllLet);
word:=word+bs[j];
Letter:=true;
inc(CurLetter);
if j=length(bs) then
if bs<>"" then
begin
inc(CntWord);
if CurLetter>MaxLetter then MaxLetter:=CurLetter;
end;

for t:= 0 to 31 do
if arGL[t] = bs[j] then
begin
inc(Slog);
break;
end;

end;
end;
Label10.Caption:= inttostr(Slog);
Label2.Caption:= inttostr(CntWord);
Label4.Caption:= inttostr(AllLet);
if CheckBox1.Checked then
Label6.Caption:=FloatToStrf(Slog/4,fffixed,4,1) else
Label6.Caption:=FloatToStrf(CntWord/2,fffixed,4,1);
Label8.Caption:= inttostr(MaxLetter);
end;

---

Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2002.04.11;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.44 MB
Время: 0.007 c