Форум: "Основная";
Текущий архив: 2005.03.20;
Скачать: [xml.tar.bz2];
ВнизСумма прописью Найти похожие ветки
← →
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;
← →
default © (2005-03-05 08:48) [9]
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
Страницы: 1 вся ветка
Форум: "Основная";
Текущий архив: 2005.03.20;
Скачать: [xml.tar.bz2];
Память: 0.51 MB
Время: 0.034 c