Регистрация | Вход
consta:array[0..31] of widestring=('a','b','c',widechar($00E7),'d','e',widechar($0259),'f','g',widechar($011F),'h','x',widechar($0131),'i','j','k','q','l','m','n','o',widechar($00F6),'p','r','s',widechar($015F),'t','u',widechar($011F),'v','y','z');f:array[0..31] of widestring=('a:','b',widechar($02A4),widechar($02A7),'d',widechar($025B),widechar($00E6),'f','g',widechar($0263),'h','x',widechar($026F),widechar($026A),widechar($0292),'k','g','l','m','n',widechar($0254),r,'p','r','s',widechar($0283),'t','u','y','v','j','z');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; ya:=#1241; yu:=widechar($00FC); sh:=#351; i1:=#305; o:=widechar($00F6); ch:=widechar($00E7); 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+'y'+yu+'z '; 2: NumStr:=NumStr+'iki y'+yu+'z '; 3: NumStr:=NumStr+yu+ch+' '+yu+'z '; 4: NumStr:=NumStr+'d'+o+'rd y'+yu+'z '; 5: NumStr:=NumStr+'be'+sh+' y'+yu+'z '; 6: NumStr:=NumStr+'alt'+i1+' y'+yu+'z '; 7: NumStr:=NumStr+'yeddi y'+yu+'z '; 8: NumStr:=NumStr+'s'+ya+'kkiz y'+yu+'z '; 9: NumStr:=NumStr+'doqquz y'+yu+'z '; end;// -------------------------------------------------------- NumTMP:=(PartNum mod 100) div 10; case NumTMP of 1: begin NumTMP:=PartNum mod 100; case NumTMP of 10: NumStr:=NumStr+'on '; 11: NumStr:=NumStr+'on bir '; 12: NumStr:=NumStr+'on iki '; 13: NumStr:=NumStr+'on '+yu+ch+' '; 14: NumStr:=NumStr+'on d'+o+'rd '; 15: NumStr:=NumStr+'on be'+sh+' '; 16: NumStr:=NumStr+'on alt'+i1+' '; 17: NumStr:=NumStr+ 'on yeddi '; 18: NumStr:=NumStr+'on s'+ya+'kkiz '; 19: NumStr:=NumStr+'on doqquz '; end; case i of 4: NumStr:=NumStr+'milyard '; 3: NumStr:=NumStr+'milyon '; 2: NumStr:=NumStr+'min '; 1: NumStr:=NumStr; end; Flag11:=True; end; 2: NumStr:=NumStr+'iyirmi '; 3: NumStr:=NumStr+'otuz '; 4: NumStr:=NumStr+'qirx '; 5: NumStr:=NumStr+ya+'lli '; 6: NumStr:=NumStr+'atlm'+i1+sh+' '; 7: NumStr:=NumStr+'yetmi'+sh+' '; 8: NumStr:=NumStr+'s'+ya+'ks'+ya+'n '; 9: NumStr:=NumStr+'doxsan '; end;// -------------------------------------------------------- NumTMP:=PartNum mod 10; if not Flag11 then begin case NumTMP of 1: if i=2 then NumStr:=NumStr+'' else NumStr:=NumStr+'bir '; 2: NumStr:=NumStr+'iki '; 3: NumStr:=NumStr+yu+ch+' '; 4: NumStr:=NumStr+'d'+o+'rd '; 5: NumStr:=NumStr+'be'+sh+' '; 6: NumStr:=NumStr+'alt'+i1+' '; 7: NumStr:=NumStr+'yeddi '; 8: NumStr:=NumStr+'s'+ya+'kkiz '; 9: NumStr:=NumStr+'doqquz '; end; case i of 4: NumStr:=NumStr+'milyard '; 3: NumStr:=NumStr+'milyon '; 2: NumStr:=NumStr+'min '; 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;function replacestr(const s, srch, replace: widestring): widestring;vari : integer;source: widestring;beginsource:= s;result:= '';repeati:=pos(srch, source);if i > 0 then beginresult := result + copy(source,1,i-1) + replace;source := copy (source,i+length(srch),maxint);endelseresult := result + source;until i<=0;end;// Перевод цифр в буквенные выраженияprocedure TSpeechS.Button1Click(Sender: TObject);var i:integer; begintntmemo2.Clear;for i:=0 to tntmemo1.Lines.Count-1 do begintntmemo2.Lines.Add(SumNumToFull(strtoint(Tntmemo1.lines.Strings[i])));end;end;//Вывод транскрипцииprocedure TSpeechS.TranscriptionClick(Sender: TObject);var i:integer;beginfor i:=0 to 31 do begintntmemo2.Text:=replacestr(tntmemo2.Text, a[i], f[i]);end;end;