Есть ли у кого-нить модулек, который делает сумму прописью?

← →
Гость22 (2005-08-04 16:23) [0]

← →
Eraser © (2005-08-04 16:27) [1]

Гость22 (04.08.05 16:23)

В Гугле полно!

← →
Ega23 © (2005-08-04 16:29) [2]

const HN:array["0".."9"] of string[10]= ("","сто ","двести ","триста ","четыреста ","пятьсот ", "шестьсот ","семьсот ","восемьсот ","девятьсот "); DC:array["0".."9"] of string[13]= ("десять ","одиннадцать ","двенадцать ","тринадцать ", "четырнадцать ","пятнадцать ","шестнадцать ","семнадцать ", "восемнадцать ","девятнадцать "); KC:array["0".."9"] of string[12]= ("","десять ","двадцать ","тридцать ","сорок ","пятьдест ", "шестьдесят ","семьдесят ","восемьдесят ","девяносто "); RM:array["0".."9",boolean] of string[7]= (("",""),("один ","одна "),("два ","две "),("три ","три "), ("четыре ","четыре "),("пять ","пять "),("шесть ","шесть "), ("семь ","семь "),("восемь ","восемь "),("девять ","девять ")); RM2:array["0".."9"] of byte= (0,1,2,2,2,0,0,0,0,0); GR:array[1..5,0..2] of string[11]= (("","",""), ("тысяч ","тысяча ","тысячи "), ("миллионов ","миллион ","миллиона "), ("миллиардов ","миллиард ","миллиарда "), ("триллионов ","триллион ","триллиона ")); function NumToStr(D:extended; Female:boolean):ShortString; var S,R:ShortString; j,k:integer; begin R:=""; IF (D<0)then begin R:="Возврат "; D:=D*(-1); end; Str(int(D):20:0,S); S:=Trim(S); while length (S) mod 3 > 0 do S:="0"+S; for j:=length(S) div 3 downto 1 do begin k:=length(S)-3*j+1; if (S[k]="0") and (S[k+1]="0") and (S[k+2]="0") then continue; if S[k+1]="1" then R:=R+HN[S[k]]+DC[S[k+2]]+GR[j,0] else R:=R+HN[S[k]]+KC[S[k+1]]+RM[S[k+2],(j=2) or ((j=1) and Female)]+ GR[j,RM2[S[k+2]]]; end; {дл перевода в win-кодировку} R[1]:=ANSIUpperCase(R[1])[1]; NumToStr:=R; // WordCount( end;

Что в uses надо прописать - не помню...

← →
Digitman © (2005-08-04 16:41) [3]

держи VBA-код (перевести в Паскаль при голове на плечах - пару раз чхнуть) :

Public Function Сумма_прописью(Summa As Double, HideCentIfZero As Boolean) As String Static Init As Boolean Static MR(0 To 4) As String Static MA(0 To 4, 0 To 9) As String Static TR(0 To 2, 0 To 9) As String Static Ex(0 To 2, 0 To 9) As String If Summa <= 0 Or Summa > 999999999999.99 Then Exit Function If Not Init Then MR(0) = "копе" MR(1) = "рубл" MR(2) = "тысяч" MR(3) = "миллион" MR(4) = "миллиард" TR(0, 0) = "" TR(0, 1) = "од" TR(0, 2) = "дв" TR(0, 3) = "три" TR(0, 4) = "четыр" TR(0, 5) = "пят" TR(0, 6) = "шест" TR(0, 7) = "сем" TR(0, 8) = "восем" TR(0, 9) = "девят" TR(1, 0) = "" TR(1, 1) = "десять" TR(1, 2) = "двадцать" TR(1, 3) = "тридцать" TR(1, 4) = "сорок" TR(1, 5) = "пятьдесят" TR(1, 6) = "шестьдесят" TR(1, 7) = "семьдесят" TR(1, 8) = "восемьдесят" TR(1, 9) = "девяносто" TR(2, 0) = "" TR(2, 1) = "сто" TR(2, 2) = "двести" TR(2, 3) = "триста" TR(2, 4) = "четыреста" TR(2, 5) = "пятьсот" TR(2, 6) = "шестьсот" TR(2, 7) = "семьсот" TR(2, 8) = "восемьсот" TR(2, 9) = "девятьсот" MA(0, 0) = "ек" MA(0, 1) = "йка" MA(0, 2) = "йки" MA(0, 3) = "йки" MA(0, 4) = "йки" MA(0, 5) = "ек" MA(0, 6) = "ек" MA(0, 7) = "ек" MA(0, 8) = "ек" MA(0, 9) = "ек" MA(1, 0) = "ей" MA(1, 1) = "ь" MA(1, 2) = "я" MA(1, 3) = "я" MA(1, 4) = "я" MA(1, 5) = "ей" MA(1, 6) = "ей" MA(1, 7) = "ей" MA(1, 8) = "ей" MA(1, 9) = "ей" MA(2, 0) = "" MA(2, 1) = "а" MA(2, 2) = "и" MA(2, 3) = "и" MA(2, 4) = "и" MA(2, 5) = "" MA(2, 6) = "" MA(2, 7) = "" MA(2, 8) = "" MA(2, 9) = "" MA(3, 0) = "ов" MA(3, 1) = "" MA(3, 2) = "а" MA(3, 3) = "а" MA(3, 4) = "а" MA(3, 5) = "ов" MA(3, 6) = "ов" MA(3, 7) = "ов" MA(3, 8) = "ов" MA(3, 9) = "ов" MA(4, 0) = "ов" MA(4, 1) = "" MA(4, 2) = "а" MA(4, 3) = "а" MA(4, 4) = "а" MA(4, 5) = "ов" MA(4, 6) = "ов" MA(4, 7) = "ов" MA(4, 8) = "ов" MA(4, 9) = "ов" Ex(0, 0) = "" Ex(0, 1) = "иннадцать" Ex(0, 2) = "енадцать" Ex(0, 3) = "надцать" Ex(0, 4) = "надцать" Ex(0, 5) = "надцать" Ex(0, 6) = "надцать" Ex(0, 7) = "надцать" Ex(0, 8) = "надцать" Ex(0, 9) = "надцать" Ex(1, 0) = "" Ex(1, 1) = "ин" Ex(1, 2) = "а" Ex(1, 3) = "" Ex(1, 4) = "е" Ex(1, 5) = "ь" Ex(1, 6) = "ь" Ex(1, 7) = "ь" Ex(1, 8) = "ь" Ex(1, 9) = "ь" Ex(2, 0) = "" Ex(2, 1) = "на" Ex(2, 2) = "е" Ex(2, 3) = "" Ex(2, 4) = "е" Ex(2, 5) = "ь" Ex(2, 6) = "ь" Ex(2, 7) = "ь" Ex(2, 8) = "ь" Ex(2, 9) = "ь" Init = True End If Dim TxtRps As String Dim i As Integer, j As Integer, k As Integer Dim R(0 To 2) As Integer Dim Acc As String, d As String TxtRps = Format(Summa, "000000000000.00") TxtRps = Left(TxtRps, 12) & "0" & Right(TxtRps, 2) For j = 4 To 0 Step -1 For i = 2 To 0 Step -1 R(i) = Mid(TxtRps, 15 - j * 3 - i, 1) Next i If j > 0 Then Acc = TR(2, R(2)) Else Acc = "" If HideCentIfZero And R(1) = 0 And R(0) = 0 Then Exit For End If If R(1) <> 1 Or R(0) = 0 Then If j > 0 Then Acc = Trim(Acc & " " & TR(1, R(1))) Acc = Trim(Acc & " " & TR(0, R(0))) Else Acc = Trim(Acc & " " & R(1) & R(0)) End If If j = 0 Or j = 2 Then k = 2 Else k = 1 Else If j > 0 Then Acc = Trim(Acc & " " & TR(0, R(0))) Else Acc = Trim(Acc & " " & R(1) & R(0)) End If k = 0 End If If Acc <> "" Or (j = 1 And Сумма_прописью <> "") Then If j = 0 Then d = "" Else d = Ex(k, R(0)) Acc = Trim(Acc & d & " " & MR(j)) If k <> 0 Then k = R(0) Acc = Acc & MA(j, k) End If Сумма_прописью = Trim(Сумма_прописью & " " & Acc) Next j Сумма_прописью = UCase(Left(Сумма_прописью, 1)) & Mid(Сумма_прописью, 2) End Function

← →
clickmaker © (2005-08-04 17:01) [4]

http://delphiworld.narod.ru/base/sum_written_out3.html
...
http://delphiworld.narod.ru/base/sum_written_out13.html

← →
Гость22 (2005-08-04 20:34) [5]

У меня есть.
http://stas258.narod.ru/frame/download/spelling.zip Пишет и рубли и доллары и еврики, может и просто слова писать

Есть ли у кого-нить модулек, который делает сумму прописью? Найти похожие ветки