Склеивание звуков

[varvara16]

Я сделала следующее

procedure TSpeechS.Button3Click(Sender: TObject);
var   n, //для хранения индекса пробела
  last, //индекс последнего найденного пробела
  i: integer;
  s: string; //временная строка
begin
tntmemo2.Clear;
n:=1;
last:=0;
while n <> 0 do
  begin
    //поиск пробела
    n:=PosEx(#32, tntMemo1.Text, n+1);
    if n <> 0 then
      //позиция пробела не равна нулю, т.е. он найден
      begin
        //копируем во временную строку слово
        s:=Copy(tntMemo1.Text,last+1,n-last-1);
        //убираем управляющие символы, если есть
        for i:=Length(s) downto 1 do
          if s[i] in [#13, #10] then Delete(s,i,1);
        //проверка есть ли в массиве такое слово
        for i:=0 to Length(words)-1 do
          if words[i] = AnsiLowerCase(s) then
            begin
tntmemo2.text:=tntmemo2.text+SumNumToFull(strtoint(words[i]));
            end;
        last:=n;
      end
    else
      //если n = 0 значит это конец текста, проверка последнего слова
      begin
        //разница только в этой строке, последний параметр, т.к. кол-во
        //букв в последнем слове неизвестно, копируем сколько есть
        s:=Copy(tntMemo1.Text,last+1,Length(tntMemo1.Text));
        for i:=Length(s) downto 1 do
          if s[i] in [#13, #10] then Delete(s,i,1);
        for i:=0 to Length(words)-1 do
          if words[i] = AnsiLowerCase(s) then
            begin
tntmemo2.text:=tntmemo2.text+SumNumToFull(strtoint(words[i]));
            end;
      end;

      end;
end;

Теперь числа выводятся правильно, но только те, которые есть в массиве

  words: array[0..19] of string = ('1','2','3','4','5','6','7','8','9','10','20','30',
                                   '40','50','60','70','80','90','100','1000');

А что делать с оставшимися числами (11, 23, 156 и т.д.)? Помогите, пожалуйста. Спасибооооо.

[mihali4]

Если позволите, присоединюсь...

А что делать с оставшимися числами

Вы не доделали промежуток 11-19. Для русского, по крайней мере, это необходимо.
Из вашего же поста - 156 будет закодировано как 100_50_6...
123, соответственно - 100_20_3.

[mutabor]

Теперь вам не надо проверять слово на вхождение в массив, вам нужно его в любом случае передать в функцию перевода прописью, и в зависимости от результата предпринимать дальнейшие действия. Вы смешали вместе два разных алгоритма.

Давайте заново. Сначала парсим в тексте слова. Если слово это подходящее число, предаем его в функцию расшифровки на составляющие. Затем озвучиваем уже эти составляющие, для этого и нужен набор звуков.
Массив с числами не нужен, достаточно такой проверки:
if StrToIntDef('найденное слово', -1) in [0..1000] then ...

[varvara16]

Я изменила процедуру следующим образом

procedure TSpeechS.Button3Click(Sender: TObject);
var   n, 
  last, 
  i: integer;
  s: string; 
begin
tntmemo2.Clear;
n:=1;
last:=0;
while n <> 0 do
  begin
    n:=PosEx(#32, tntMemo1.Text, n+1);
    if n <> 0 then
      begin
        s:=Copy(tntMemo1.Text,last+1,n-last-1);
        for i:=Length(s) downto 1 do
          if s[i] in [#13, #10] then Delete(s,i,1);
            if StrTointDef(s, -1) in [0..200] then begin
tntmemo2.text:=tntmemo2.text+SumNumToFull(strtoint(s));
            end;
        last:=n;
      end
    else
      begin
s:=Copy(tntMemo1.Text,last+1,Length(tntMemo1.Text));
        for i:=Length(s) downto 1 do
          if s[i] in [#13, #10] then Delete(s,i,1);
            if StrToIntDef(s, -1) in [0..250] then begin
tntmemo2.text:=tntmemo2.text+SumNumToFull(strtoint(s));
            end;
      end;

      end;
end;

Но удалось взять промежуток [0..200], но до 1000 не получается, выходит сообщение о выходе за пределы границ.

При использовании юникода не все звуки произносятся правильно, может быть где-то у меня ошибка? Помогите, пожалуйста.

procedure TSpeechS.Button1Click(Sender: TObject);
var   n,
  last, 
  i: integer;
  s: widestring; 
  ya,yu,o1,ch,sh,i1:widestring;
  words1: array[0..19] of widestring;
  begin
     ya:=#1241;
   yu:=widechar($00FC);
   sh:=#351;
   i1:=#305;
   o1:=widechar($00F6);
   ch:=widechar($00E7);
  words1[0]:='bir';
words1[1]:='iki';
words1[2]:=yu+''+ch;
words1[3]:='d'+o1+'rd';
words1[4]:='be'+sh;
words1[5]:='alt'+i1;
words1[6]:='yeddi';
words1[7]:='s'+ya+'kkiz';
words1[8]:='doqquz';
words1[9]:='on';
words1[10]:='iyirmi';
words1[11]:='otuz';
words1[12]:='q'+i1+'rx';
words1[13]:=ya+'lli';
words1[14]:='altm'+i1+''+sh;
words1[15]:='yetm'+i1+''+sh;
words1[16]:='s'+ya+'ks'+ya+'n';
words1[17]:='doxsan';
words1[18]:='y'+yu+'z';
words1[19]:='min';
PlayMode:=pmPlaySound;
n:=1;
last:=0;
while n <> 0 do
  begin
    n:=PosEx(#32, tntMemo2.Text, n+1);
    if n <> 0 then
      begin
        s:=Copy(tntMemo2.Text,last+1,n-last-1);
        for i:=Length(s) downto 1 do
{          if s[i] in [#13, #10] then Delete(s,i,1);} // Это не исльзуется с юникодом
             s:=StringReplace(s, #13, ' ', [rfReplaceAll]);//?
             s:=StringReplace(s, #10, ' ', [rfReplaceAll]);//?

        for i:=0 to Length(words1)-1 do
          if words1[i] = AnsiLowerCase(s) then
            begin
              PlaySnd(i,PlayMode);
              Break;
            end;
        last:=n;
      end
    else
      begin
        s:=Copy(tntMemo2.Text,last+1,Length(tntMemo2.Text));
        for i:=Length(s) downto 1 do
{          if s[i] in [#13, #10] then Delete(s,i,1);} //Это не исльзуется с юникодом
             s:=StringReplace(s, #13, ' ', [rfReplaceAll]);//?
             s:=StringReplace(s, #10, ' ', [rfReplaceAll]);
        for i:=0 to Length(words1)-1 do
          if words1[i] = AnsiLowerCase(s) then
            begin
              PlaySnd(i,PlayMode);
              Break;
            end;
      end;

      end;
end;

Спасибо огромное.

[mutabor]

Но удалось взять промежуток [0..200], но до 1000 не получается, выходит сообщение о выходе за пределы границ.

Я совсем забыл, у множества предел 256. Сделайте так:
tmp:=StrToIntDef(s, -1);
if (tmp >= 0) and (tmp <= 1000) then...

При использовании юникода не все звуки произносятся правильно, может быть где-то у меня ошибка? Помогите, пожалуйста.

Не обязательно представлять идентификаторы звуков в виде строк. Если цифры прописью нужны, то оставьте этот код, но к звуку он относиться не будет.
Для звука можно несколько переделать функцию конвертации, на выходе она должна выдавать не строку а массив индексов звуков, к-рые нужно произнести.
Например на вход функции дали число 528, она вернула массив с индексами звуков: "пятьсот", "двадцать", "восемь". Объявление такой функции:

type
  TIndexArray = array of byte; 
  {если в массиве звуков будет более 256 элементов, то нужен тип integer}

function DigitToIndex(d: integer): TIndexArray;

//использование
IA:=DigitToIndex(528);
for i:=0 to Length(IA)-1 do
  PlaySnd(IA[i],PlayMode);

[varvara16]

А почему у меня неправильно произносятся звуки? Я ввожу строку '1 2 3 4 1', а прграмма читает 'один два один два один' и все. У меня 20 звуков для цифр (больше для азербайджанкого языка и не надо). Это 1,2,3,4,5,6,7,8,9,10,20,30,40,50,60 ,70,80,90,100 и 1000. Почему же она читает неправильно? Помогите разобраться. Спасибо.

[varvara16]

Спасибо вам огрооооомное!!! Я изменила процедуру вывода чисел, и все заработало

function SumNumToFull(Number:real) : widestring;
var
   PartNum, TruncNum, NumTMP, D : longword;
   NumStr : widestring;
   i, R : byte;
   Flag11 : boolean;
   ya,yu,sh,i1,o,ch:widestring;
begin
   D:=1000000000;
   R:=5;
      TruncNum:=Trunc(Number);
   if TruncNum<>0 then
      repeat
         PartNum:=TruncNum div D;
         Dec(R);
         D:=D div 1000;
      until PartNum<>0
   else R:=0;

   FOR i:=R DOWNTO 1 DO
      BEGIN
         Flag11:=False;
// -------------------------------------------------------
         NumTMP:=PartNum div 100; 
         case NumTMP of
            1: NumStr:=NumStr+'100 ';
            2: NumStr:=NumStr+'2 100 ';
            3: NumStr:=NumStr+'3 100 ';
            4: NumStr:=NumStr+'4 100 ';
            5: NumStr:=NumStr+'5 100 ';
            6: NumStr:=NumStr+'6 100 ';
            7: NumStr:=NumStr+'7 100 ';
            8: NumStr:=NumStr+'8 100 ';
            9: NumStr:=NumStr+'9 100 ';
         end;
// --------------------------------------------------------
         NumTMP:=(PartNum mod 100) div 10; 
         case NumTMP of
            1:
               begin
                  NumTMP:=PartNum mod 100;
                  case NumTMP of
                     10: NumStr:=NumStr+'10 ';
                     11: NumStr:=NumStr+'10 1 ';
                     12: NumStr:=NumStr+'10 2 ';
                     13: NumStr:=NumStr+'10 3 ';
                     14: NumStr:=NumStr+'10 4 ';
                     15: NumStr:=NumStr+'10 5 ';
                     16: NumStr:=NumStr+'10 6 ';
                     17: NumStr:=NumStr+ '10 7 ';
                     18: NumStr:=NumStr+'10 8 ';
                     19: NumStr:=NumStr+'10 9 ';
                  end;
                  case i of
                     4: NumStr:=NumStr+'1000000000 ';
                     3: NumStr:=NumStr+'1000000 ';
                     2: NumStr:=NumStr+'1000 ';
                     1: NumStr:=NumStr;
                  end;
                  Flag11:=True;
               end;
            2: NumStr:=NumStr+'20 ';
            3: NumStr:=NumStr+'30 ';
            4: NumStr:=NumStr+'40 ';
            5: NumStr:=NumStr+'50 ';
            6: NumStr:=NumStr+'60 ';
            7: NumStr:=NumStr+'70 ';
            8: NumStr:=NumStr+'80 ';
            9: NumStr:=NumStr+'90 ';
         end;
// --------------------------------------------------------
         NumTMP:=PartNum mod 10; 
         if not Flag11 then
            begin
               case NumTMP of
                  1: if i=2 then NumStr:=NumStr+''
                     else NumStr:=NumStr+'1 ';
                  2: NumStr:=NumStr+'2 ';
                  3: NumStr:=NumStr+'3 ';
                  4: NumStr:=NumStr+'4 ';
                  5: NumStr:=NumStr+'5 ';
                  6: NumStr:=NumStr+'6 ';
                  7: NumStr:=NumStr+'7 ';
                  8: NumStr:=NumStr+'8 ';
                  9: NumStr:=NumStr+'9 ';
               end;

               case i of
                  4:
                        NumStr:=NumStr+'1000000000 ';
                  3:
                        NumStr:=NumStr+'1000000 ';
                  2:
                        NumStr:=NumStr+'1000 ';
               end; {case}
            end; {begin}
// --------------------------------------------------------
            if i>1 then
               begin
                  PartNum:=(TruncNum mod (D*1000)) div D;
                  D:=D div 1000;
               end;
      END; {BEGIN in FOR}


   SumNumToFull:=NumStr;
end; //---SumNumToFull

Еще раз спасибо!!!!!!!!!!!

[varvara16]

Извините, что опять беспокою. А как можно остановить воспроизведение или поставить паузу, т. е. сделать кнопки как в mediaplayer stop и pause.
Помогите, пожалуйста. Спасибо за все.

[mutabor]

PlaySound можно только остановить. Почитайте здесь, как это сделать
http://msdn.microsoft.com/en-us/library/ms712879.aspx

Если надо на паузу, используйте TMediaplayer.

[varvara16]

Когда я нажимаю на кнопку, то остановить воспроизведение не получается.

procedure TForm1.TBAudioClick(Sender: TObject);
var
 n,last,i,tmp: integer;
  s: string;
  ya,yu,o1,ch,sh,i1:widestring;
  words1: array[0..19] of widestring;
    a1:array[0..20000] of widestring;
    kk:widestring;
begin
kk:='';
  s:='';
  if tntmemo2.SelText='' then
  text1:=tntmemo2.Text
  else
  text1:=tntmemo2.SelText;
Text1:=replacestr(Text1, #13#10, '');
if length(Text1) mod 2<>0 then begin
Text1:=Text1+' '; end;
for i:=0 to length(Text1)div 2 - 1  do begin
a1[i]:=widestring(Text1[2*i+1])+widestring(Text1[2*i+2]);
a1[i]:=replacestr(a1[i], ' ', '_');
end;
   for i:=0 to length(Text1) div 2  do begin
   kk:=kk+a1[i]+' ';
   end;
for i:=0 to length(kk) - 1  do begin
kk:=replacestr(kk, a[i], f[i]);
end;
 text1:=kk;
  PlayMode:=pmPlaySound;
n:=1;
last:=0;
while n <> 0 do
  begin
    n:=PosEx(#32, Text1, n+1);
    if n <> 0 then
      begin
        s:=Copy(Text1,last+1,n-last-1);
        for i:=Length(s) downto 1 do
          if s[i] in [#13, #10] then Delete(s,i,1);
        for i:=0 to Length(words)-1 do
          if words[i] = AnsiLowerCase(s) then
            begin
              PlaySnd(i,PlayMode);
              Break;
            end;
        last:=n;
      end
    else
      begin
         s:=Copy(Text1,last+1,Length(Text1));
        for i:=Length(s) downto 1 do
          if s[i] in [#13, #10] then Delete(s,i,1);
        for i:=0 to Length(words)-1 do
          if words[i] = AnsiLowerCase(s) then
            begin
              PlaySnd(i,PlayMode);
              Break;
            end;
      end;
  end;
end;

Я написала в кнопке стоп

PlaySound(nil,0,0);

Но передать ей управление не удается. Помогите, пожалуйста. Огромное спасибо.