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

Советы » Тексты » Сумма прописью

const

tril = 1000000000000.00; bil = 1000000000.00; mill = 1000000.00; thou = 1000.00; Tri = 'три '; Chetire = 'четыре '; Pyat = 'пять '; Shest = 'шесть '; Sem = 'семь '; Vosem = 'восемь '; Devyat = 'девять '; MyStr: array[0..9] of PChar = ('0', '1', '2', '3', '4', '5', '6', '7', '8', '9'); EdinM: array[0..9] of PChar = ('', 'один ', 'два ', Tri, Chetire, Pyat, Shest, Sem, Vosem, Devyat); EdinH: array[0..9] of PChar = ('', 'одна ', 'две ', Tri, Chetire, Pyat, Shest, Sem, Vosem, Devyat); EdinS: array[0..9] of PChar = ('', 'одно ', 'два ', Tri, Chetire, Pyat, Shest, Sem, Vosem, Devyat); Decs: array[0..9] of PChar = ('десять ', 'одиннадцать ', 'двенадцать ', 'тринадцать ', 'четырнадцать ', 'пятнадцать ', 'шестнадцать ', 'семнадцать ', 'восемнадцать ', 'девятнадцать '); San: array[0..9] of PChar = ('', '', 'двадцать ', 'тридцать ', 'сорок ', 'пятьдесят ', 'шестьдесят ', 'семьдесят ', 'восемьдесят ', 'девяносто '); Mil: array[0..9] of PChar = ('', 'сто ', 'двести ', 'триста ', 'четыреста ', 'пятьсот ', 'шестьсот ', 'семьсот ', 'восемьсот ', 'девятьсот '); type

CurType = array[0..255] of Char; function

GetRealSumma(ASumma: double): PChar; var

R,U,Fr: extended; XX,X,Y,Z,T,K: longint; ABuffer: CurType; d: array[0..200] of Char; function

GetCount(ACount: longint; Sex: byte): PChar; var

X1,Y1,Z1: byte; begin

X1 := ACount div 100; Y1 := (ACount mod 100) div 10; Z1 := (ACount mod 100) mod 10; StrCopy(d, Mil[X1]); if (Y1 * 10 + Z1) in [10..19] then StrCat(d, Decs[Y1 * 10 + Z1 - 10]) else begin StrCat(d, San[Y1]); Case Sex of 1: StrCat(d, EdinM[Z1]); 2: StrCat(d, EdinH[Z1]); 3: StrCat(d, EdinS[Z1]); end; end; GetCount := @d; end

; begin

ABuffer[0] := #0; U := ASumma; if (U >= 1000 * tril) or (U < 0) then begin StrCopy(ABuffer, '0.00'); GetRealSumma := @ABuffer; Exit; end; Fr := Frac(U); if Fr > 0.994 then begin Fr := 0.000; U := U + 1; end; R := U - Fr; K := Round(100.00 * Fr); XX := Trunc(R / tril); R := R - tril * Int(R / tril); X := Trunc(R / bil); R := R - bil * Int(R / bil); Y := Trunc(R / mill); R := R - mill * Int(R / mill); Z := Trunc(R / thou); R := R - thou * Int(R / thou); T := Trunc(R); ABuffer[0] := #0; if XX > 0 then begin StrCat(ABuffer, GetCount(XX, 1)); if (XX mod 100) in [10..19] then StrCat(ABuffer, 'триллионов ') else Case (XX mod 100) mod 10 of 1: StrCat(ABuffer, 'триллион '); 2..4: StrCat(ABuffer, 'триллиона '); else StrCat(ABuffer, 'триллионов '); end; end; if X > 0 then begin StrCat(ABuffer, GetCount(X, 1)); if (X mod 100) in [10..19] then StrCat(ABuffer, 'миллиардов ') else Case (X mod 100) mod 10 of 1: StrCat(ABuffer, 'миллиард '); 2..4: StrCat(ABuffer, 'миллиарда '); else StrCat(ABuffer, 'миллиардов '); end; end; if Y > 0 then begin StrCat(ABuffer, GetCount(Y, 1)); if (Y mod 100) in [10..19] then StrCat(ABuffer, 'миллионов ') else Case (Y mod 100) mod 10 of 1: StrCat(ABuffer, 'миллион '); 2..4: StrCat(ABuffer, 'миллиона '); else StrCat(ABuffer, 'миллионов '); end; end; if Z > 0 then begin StrCat(ABuffer, GetCount(Z, 2)); if (Z mod 100) in [10..19] then StrCat(ABuffer, 'тысяч ') else Case (Z mod 100) mod 10 of 1: StrCat(ABuffer, 'тысяча '); 2..4: StrCat(ABuffer, 'тысячи '); else StrCat(ABuffer, 'тысяч '); end; end; if T > 0 then begin StrCat(ABuffer, GetCount(T, 1)); if (T mod 100) in [10..19] then begin StrCat(ABuffer, 'рублей'); StrCat(ABuffer, ' '); end else Case (T mod 100) mod 10 of 1: begin StrCat(ABuffer, 'рубль'); StrCat(ABuffer, ' '); end; 2..4: begin StrCat(ABuffer, 'рубля'); StrCat(ABuffer, ' '); end; else begin StrCat(ABuffer, 'рублей'); StrCat(ABuffer, ' '); end; end; end else if U >= 1 then begin StrCat(ABuffer, 'рублей'); StrCat(ABuffer, ' '); end; StrCopy(d, MyStr[K div 10]); StrCat(d, MyStr[K mod 10]); StrCat(ABuffer, d); StrCat(ABuffer, ' '); if K in [10..19] then begin StrCat(ABuffer, 'копеек') end else Case (K mod 100) mod 10 of 1: StrCat(ABuffer, 'копейка'); 2..4: StrCat(ABuffer, 'копейки') else StrCat(ABuffer, 'копеек') end; if ABuffer[Pred(StrLen(ABuffer))] = #32 then ABuffer[Pred(StrLen(ABuffer))] := #0; ABuffer[0]:=UpChar(ABuffer[0]); GetRealSumma := @ABuffer; end

;

Другое по теме:

Категории

Статьи

Советы

Copyright © 2022 - All Rights Reserved - www.delphirus.com