Сумма прописью

← →
ser35 (2005-03-04 14:29) [0]

Возможно повторяюсь. Подскажите, как можно преобразовать число 6 487 - в "шесть тысяч четыреста восемьдесят семь" Спасибо заранее

← →
kukuikar © (2005-03-04 14:36) [1]

http://narod.yandex.ru/cgi-bin/yandsearch?user=delphiworld&b_id=&text=%F7%E8%F1%EB%EE+%EF%F0%EE%EF%E8%F1%FC%FE&where=2&r eferrer1=http%3A%2F%2Fnarod.yandex.ru&referrer2=narod.yandex.ru&submit.x=44&submit.y=4

← →
Reindeer Moss Eater © (2005-03-04 14:36) [2]

if Sum = 6487 then
SumString := "шесть тысяч четыреста восемьдесят семь"
else
SumString :="Спасибо заранее";

← →
Digitman © (2005-03-04 14:43) [3]

> как можно преобразовать

именно преобразовать - никак.

если таки поставить в соответствие, то

if число = 6487 тогда
строка = "шесть тысяч четыреста восемьдесят семь"

если же нужен именно интеллектуальный алгоритм. который анализирует входное числовое значение и по рез-там анализа формирует некую выходную строку, то таких алгоритмов - навалом ... Гугль выдаст море ссылок ...

если не лень, можешь портировать в Паскаль 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

← →
kukuikar © (2005-03-04 14:46) [4]

> kukuikar © (04.03.05 14:36) [1]
> http://narod.yandex.ru/cgi-bin/yandsearch?user=delphiworld&b_id=&text=%F7%E8%F1%EB%EE+%EF%F0%EE%EF%E8%F1%FC%FE&where=2&r
> eferrer1=http%3A%2F%2Fnarod.yandex.ru&referrer2=narod.yandex.ru&submit.x=44&submit.y=4

Теперь подругому.
Сходи на http://delphiworld.narod.ru

Очень рекомендую.

← →
ser35 (2005-03-04 14:51) [5]

Спасибо ВСЕМ за советы!

← →
Rule © (2005-03-04 15:11) [6]

если интересует есть встреонный в фастрепор только третий функция такая тоже

← →
ser35 (2005-03-04 18:10) [7]

Мастера, не серчайте сильно. Как ни пытался не могу разобраться: Нужно, чтобы, при нажатии кнопки сумма цифровая из одного Edit-a перешла в другой Edit.Как ни пробовал - не получается. Подскажите, пожалуйста, куда мне эти Edits впихнуть?

procedure TForm1.Button7Click(Sender: TObject); function ConvertToWord(N: word): string; const Sot : array[1..9] of string[13] = ("сто","двести","триста","четыреста","пятьсот", "шестьсот","семьсот","восемьсот","девятьсот"); Des : array[2..9] of string[13] = ("двадцать","тридцать","сорок","пятьдесят", "шестьдесят","семьдесят","восемьдесят","девяносто"); Edin : array[0..19] of string[13] = ("","один","два","три","четыре","пять","шесть","семь", "восемь","девять","десять","одиннадцать","двенадцать", "тринадцать","четырнадцать","пятнадцать", "шестнадцать","семнадцать","восемнадцать","девятнадцать"); var S: string; begin S:=""; N:=N mod 1000; if N>99 then begin S:=Sot[N div 100]+" "; N:=N mod 100; end; if N>19 then begin S:=S+Des[N div 10]+" "; N:=N mod 10; end; Result:=S+Edin[N]; end; { Возвращает сумму прописью } function CenaToStr(r: Currency): string; var N, k: longint; S: string; begin N:=trunc(R); S:=""; if N<>0 then begin if N>999999 then begin k:=N div 1000000; S:=ConvertToWord(k); if ((k-(k div 100)*100)>10) and ((k-(k div 100)*100)<20) then S:=S+" миллионов" else if (k mod 10)=1 then S:=S+" миллион" else if ((k mod 10)>=2)and((k mod 10)<=4) then S:=S+" миллиона" else S:=S+" миллионов"; N:=N mod 1000000; end; if N>999 then begin k:=N div 1000; S:=S+" "+ConvertToWord(k); if ((k-(k div 100)*100)>10)and((k-(k div 100)*100)<20) then S:=S+" тысяч" else if (k mod 10)=1 then begin SetLength(S, Length(S)-2); S:=S+"на тысяча"; end else if (k mod 10)=2 then begin SetLength(S, length(S)-1); S:=S+"е тысячи"; end else if ((k mod 10)>=3)and((k mod 10)<=4) then S:=S+" тысячи" else S:=S+" тысяч"; N:=N mod 1000; end; k:=N; S:=S+" "+ConvertToWord(k); if ((k-(k div 100)*100)>10)and((k-(k div 100)*100)<20) then S:=S+" рублей" else if (k mod 10)=1 then S:=S+" рубль" else if (k mod 10)=2 then S:=S+" рубля" else if ((k mod 10)>=3)and((k mod 10)<=4) then S:=S+" рубля" else S:=S+" рублей"; end; if trunc(R)<>R then begin k:=round(frac(R)*100); S:=S+" "+IntToStr(K); if ((k-(k div 100)*100)>10)and((k-(k div 100)*100)<20) then S:=S+" копеек" else if (k mod 10)=1 then begin S:=S+" копейка"; end else if (k mod 10)=2 then begin S:=S+" копейки"; end else if ((k mod 10)>=3)and((k mod 10)<=4) then S:=S+" копейки" else S:=S+" копеек"; end else S:=S+" 00 копеек"; S:=Trim(S); if S<>"" then S[1]:=AnsiUpperCase(S[1])[1]; result:=S; end;

← →
MU (2005-03-04 18:17) [8]

procedure TForm1.Button7Click(Sender: TObject)
begin
Edit2.Text := Edit1.Text;
//
//Edit2.Text := CenaToStr(StrToCurrDef(Edit1.Text, 0));
end;

const Mas1: Array["0".."9", 1..3] of String = ( ("", "", ""), ("сто ", "", "один "), ("двести ", "двадцать ", "два "), ("триста ", "тридцать ", "три "), ("четыреста ", "сорок ", "четыре "), ("пятьсот ", "пятьдесят ", "пять "), ("шестьсот ", "шестьдесят ", "шесть "), ("семьсот ", "семьдесят ", "семь "), ("восемьсот ", "восемьдесят ", "восемь "), ("девятьсот ", "девяносто ", "девять ") ); Mas2: Array["0".."9"] of String = ( "десять ", "одиннадцать ", "двенадцать ", "тринадцать ", "четырнадцать ", "пятнадцать ", "шестнадцать ", "семнадцать ", "восемнадцать ", "девятнадцать " ); Mas3: Array["1".."2"] of String = ( "одна ", "две "); Mas4: Array["0".."9", 1..4] of String = ( ("", "тысяч ", "миллионов ", "миллиардов "), ("", "тысяча ", "миллион ", "миллиард "), ("", "тысячи ", "миллиона ", "миллиарда "), ("", "тысячи ", "миллиона ", "миллиарда "), ("", "тысячи ", "миллиона ", "миллиарда "), ("", "тысяч ", "миллионов ", "миллиардов "), ("", "тысяч ", "миллионов ", "миллиардов "), ("", "тысяч ", "миллионов ", "миллиардов "), ("", "тысяч ", "миллионов ", "миллиардов "), ("", "тысяч ", "миллионов ", "миллиардов ") ); function GetRepresentationInWords(S: String): String; var i: Byte; Str: PChar; begin Result := ""; if S = "" then Exit; for i := 1 to Length(S) do if S[i] <> "0" then Break; if i = Length(S) + 1 then begin Result := "Ноль"; Exit end; Str := @S[1]; while Length(S) mod 3 <> 0 do Insert("0", S, 1); for i := Length(S) div 3 downto 1 do begin if (Str[0] = "0") and (Str[1] = "0") and (Str[2] = "0") then begin Inc(Str, 3); Continue; end; Result := Result + Mas1[Str[0], 1]; if Str[1] = "1" then Result := Result + Mas2[Str[2]] + Mas4["0", i] else begin Result := Result + Mas1[Str[1], 2]; if (i = 2) and (Str[2] in ["1".."2"]) then Result := Result + Mas3[Str[2]] else Result := Result + Mas1[Str[2], 3]; Result := Result + Mas4[Str[2], i]; end; Inc(Str, 3) end; SetLength(Result, Length(Result) - 1) end;
вот может пригодиться
писал давно, строго не судить, даже не помню как работает уже...
проверьте имеющиеся ф-ции на скорость и выберите более быструю
для добавления триллионов и тп достаточно изменить немного Mas4

Сумма прописью Найти похожие ветки