| Форумы
ЧАТ |
Орешник |
|
| Форумы -» | Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG |
|
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
Есть ли у кого-нить модулек, который делает сумму прописью? [D7, Win95/98]
Гость22 © (2005-08-04 16:23:00)Есть ли у кого-нить модулек, который делает сумму прописью?
TStas (2005-08-04 21:20:00) [1]У меня есть.
http://stas258.narod.ru/frame/download/spelling.zipПишет и рубли и доллары и еврики, может и просто слова писать
Гость22 (2005-08-04 20:34:00) [2]
> clickmaker © (04.08.05 17:01) [4]
в первой ссылке ошибка
clickmaker (2005-08-04 17:01:00) [3]http://delphiworld.narod.ru/base/sum_written_out3.html
...
http://delphiworld.narod.ru/base/sum_written_out13.html
Digitman (2005-08-04 16:41:00) [4]держи 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 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
Ega23 (2005-08-04 16:29:00) [5]
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 надо прописать - не помню...
Eraser (2005-08-04 16:27:00) [6]Гость22 (04.08.05 16:23)
В Гугле полно!
| |
