real прописью

← →
fedor (2004-08-16 10:14) [0]

Существует ли такая функция, которая переводила число т.о.:
4123,45 - "четыре тысячи сто двадцать три, сорок пять"?
Если нет, то не подскажите, как такую ф-ию можно написать?
Алгоритм какой-нить.

← →
Mim1 © (2004-08-16 10:25) [1]

http://www.yandex.ru/yandsearch?text=%F1%F3%EC%EC%E0+%EF%F0%EE%EF%E8%F1%FC%FE+delphi+&stype=www&rpt=rad

← →
Григорьев Антон © (2004-08-16 10:29) [2]

http://www.delphikingdom.com/asp/nets.asp?ItemID=431

← →
46_55_41_44 © (2004-08-16 10:31) [3]

Это один пример!
Мне нужен был, чтобы переводить суммы в цифрах в пропись...
Да кстати так как я Бакинец, то валюта наша :)
Возьми и поменяй под свой случай... Работает!!! :)

function GetTextFromDig(tut : Double; Currensy_ : String) : String; var Number, Three, coin, AStr, str, sstr, strp, S, S1, S2, S3, myResult : String; RealNum : Double; PointPos, i, Col, Len : Integer; LenStr, threeNum, r, n, Manat : int64; Bool1 : Boolean; begin Result := ""; Bool1 := Currensy_ <> ""; if Copy(VarToStr(tut), length(VarToStr(tut)), 1) = DecimalSeparator then exit; If Bool1 then if Lang_Id = "Rs" then begin If tut = 0 then exit; RealNum := StrtoFloat(VarToStr(tut)); Number := FloattoStr(Trunc(RealNum)); Len := Length(Number); Col := 0; While Number > "" do begin Three := Copy(Number, Length(Number) - 2, 3); If Length(Three) < 3 then Three := "0" + Three; If Length(Three) < 3 then Three := "0" + Three; Number := Copy(Number, 1, Length(Number) - 3); Inc(Col); S := ""; case StrtoInt(Three[1]) of 1 : S := " сто"; 2 : S := " двести"; 3 : S := " триста"; 4 : S := " четыреста"; 5 : S := " пятьсот"; 6 : S := " шестьсот"; 7 : S := " семьсот"; 8 : S := " восемьсот"; 9 : S := " девятьсот"; end; case StrtoInt(Three[2]) of 1 : Case StrtoInt(Three[3]) of 0 : S := S + " десять"; 1 : S := S + " одиннадцать"; 2 : S := S + " двенадцать"; 3 : S := S + " тринадцать"; 4 : S := S + " четырнадцать"; 5 : S := S + " пятнадцать"; 6 : S := S + " шестнадцать"; 7 : S := S + " семнадцать"; 8 : S := S + " восемнадцать"; 9 : S := S + " девятнадцать"; end; 2 : S := S + " двадцать"; 3 : S := S + " тридцать"; 4 : S := S + " сорок"; 5 : S := S + " пятьдесят"; 6 : S := S + " шестьдесят"; 7 : S := S + " семьдесят"; 8 : S := S + " восемьдесят"; 9 : S := S + " девяносто"; end; If Three[2] <> "1" then case StrtoInt(Three[3]) of 1 : case Col of 1, 3, 4 : S := S + " один"; 2 : S := S + " одна"; end; 2 : case Col of 1, 3, 4 : S := S + " два"; 2 : S := S + " две"; end; 3 : S := S + " три"; 4 : S := S + " четыре"; 5 : S := S + " пять"; 6 : S := S + " шесть"; 7 : S := S + " семь"; 8 : S := S + " восемь"; 9 : S := S + " девять"; end; case Col of 2 : If StrtoInt(Three[2]) = 1 then S := S + " тысяч" else Case StrtoInt(Three[3]) of 0 ://if Len in [5, 6, 7] then if Three <> "000" then S := S + " тысяч"; 1 : S := S + " тысяча"; 2, 3, 4 : S := S + " тысячи"; 5, 6, 7, 8, 9 : S := S + " тысяч"; end; 3 : If StrtoInt(Three[2]) = 1 then S := S + " миллионов" else Case StrtoInt(Three[3]) of 0 ://if Len in [8, 9, 10] then if Three <> "000" then S := S + " миллионов"; 1 : S := S + " миллион"; 2, 3, 4 : S := S + " миллиона"; 5, 6, 7, 8, 9 : S := S + " миллионов"; end; 4 : If StrtoInt(Three[2]) = 1 then S := S + " миллиардов" else Case StrtoInt(Three[3]) of 0 : if Len > 10 then S := S + " миллиардов"; 1 : S := S + " миллиард"; 2, 3, 4 : S := S + " миллиарда"; 5, 6, 7, 8, 9 : S := S + " миллиардов";
...
to be continued... не хватило места :)

← →
46_55_41_44 © (2004-08-16 10:31) [4]

Удалено модератором

← →
46_55_41_44 © (2004-08-16 10:33) [5]

продолжение...
да кстати... сорри за то, что верхушка 2 раза пришла ))) просто не терпеливый я, как все кавказцы ))
end; end; If S <> "" then myResult := S + myResult; end; S1 := Copy(IntToStr(Trunc(tut)), Length(IntToStr(Trunc(tut))), 1); // if Bool1 then // S2 := Query_.FieldByName("Admanat" + s1).AsString; S2 := "манат"; If Int(tut)= tut then begin if Bool1 then S3 := "гяпик" end else begin S3 := "гяпик"; end; PointPos := Pos(decimalseparator, VarToStr(tut)); If (PointPos <> 0) and (Copy(VarToStr(tut), PointPos + 1, 2) <> "") then If Length(Copy(VarToStr(tut), PointPos + 1, 2)) = 1 then myResult := myResult + " " + S2 + " " + Copy(VarToStr(tut), PointPos + 1, 2) + "0 " + S3 else myResult := myResult + " " + S2 + " " + Copy(VarToStr(tut), PointPos + 1, 2) + " " + S3; While myResult[1] = " " do myResult := Copy(myResult, 2, Length(myResult) - 1); myResult[1] := Chr(Ord(myResult[1]) - 32); if Int(tut) = tut then myResult := myResult + " " + S2 + " 00 " + S3; Result := myResult; end else if (Lang_Id = "AzL") or (Lang_Id = "AzC") or (Lang_Id = "En") then begin str := ""; coin := ""; Manat := Trunc(tut); If (Pos(DecimalSeparator, VarToStr(tut)) <> Length(VarToStr(tut))) and (Pos(DecimalSeparator, VarToStr(tut)) <> 0) then begin S1 := VarToStr(tut); coin := copy(S1, Pos(DecimalSeparator, S1) + 1, Length(S1) - Pos(DecimalSeparator, S1)); If length(coin) = 1 then coin := coin + "0"; end; str := IntToStr(Manat); LenStr := Length(str); n := LenStr div 3; r := LenStr mod 3; aStr := ""; if r = 0 then begin r := 3; n := n - 1; end; For i := n + 1 downto 1 do begin threeNum := StrToInt(copy(str, 1, r)); sstr := DigitToWord3(threeNum); if (Lang_Id = "AzL") or (Lang_Id = "AzC") then Case i of 1 : begin S1 := Copy(VarToStr(Manat), Length(VarToStr(Manat)), 1); if Bool1 then S2 := "манат"; strp := S2;//"манат"; end; 2 : if sstr <> "" then strp := "мин" else strp := ""; 3 : if sstr <> "" then strp := "милйон" else strp := ""; 4 : if sstr <> "" then strp := "милйард" else strp := ""; 5 : if sstr <> "" then strp := "трилйон" else strp := ""; end else Case i of 1 : begin S1 := Copy(VarToStr(Manat), Length(VarToStr(Manat)), 1); if Bool1 then S2 := "манат"; strp := S2;//"манат"; end; 2 : if sstr <> "" then strp := "thousand" else strp := ""; 3 : if sstr <> "" then strp := "million" else strp := ""; 4 : if sstr <> "" then strp := "billion" else strp := ""; 5 : if sstr <> "" then strp := "trillion" else strp := ""; end; if sstr <> "" then astr := aStr + sstr + " " + strp + " " else if strp = "" then astr := aStr + " " else astr := aStr + strp + " "; str := copy(str, r + 1, LenStr - r); r := 3; LenStr := Length(str); end; if coin <> "" then begin S1 := copy(coin, length(coin), 1); coin := coin + " " + "гяпик"; end; astr := astr + " " + coin; while aStr[1] = " " do astr := copy(astr, 2, Length(astr) - 1); i := ord(aStr[1]); aStr[1] := chr(i - 32); if Bool1 then begin if Int(tut) = tut then astr := astr + " 00 " + "гяпик"; end else if Int(tut) = tut then astr := astr; while pos(" ", astr) <> 0 do astr := ReplaceStr(astr, " ", " "); Result := astr; end; end;

← →
fedor (2004-08-16 11:22) [6]

Всем спасибо!

← →
fedor (2004-08-16 11:45) [7]

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