Советы по Delphi

Число строкой IV


Вот еще одно решение, присланное читателем.

Уважаемый Валентин!

Вполне возможно, что код решения данной ф-ции несколько сыроват и неряшлив, но он работает для бухгалтерских программ (соблюдены правила написания суммы прописью). При вызове ф-ции надо также указывать сокращенные названия основных и разменных денежных единиц (например руб. коп.).

Редянов Денис

    function CifrToStr(Cifr:String;Pr:Integer;Padeg:Integer) : string;
{Функция возвращает прописью 1 цифры признак 3-единицы 2-десятки 1-сотни 4-11-19
Padeg - 1-нормально 2- одна, две } var i:Integer;


begin
i:=StrToInt(Cifr); if Pr = 1 Then case i of 1: CifrToStr :='сто'; 2: CifrToStr :='двести'; 3: CifrToStr :='триста'; 4: CifrToStr :='четыреста'; 5: CifrToStr :='пятьсот'; 6: CifrToStr :='шестьсот'; 7: CifrToStr :='семьсот'; 8: CifrToStr :='восемьсот'; 9: CifrToStr :='девятьсот'; 0: CifrToStr :=''; end else if Pr = 2 Then case i of 1: CifrToStr :=''; 2: CifrToStr :='двадцать'; 3: CifrToStr :='тридцать'; 4: CifrToStr :='сорок'; 5: CifrToStr :='пятьдесят'; 6: CifrToStr :='шестьдесят'; 7: CifrToStr :='семьдесят'; 8: CifrToStr :='восемьдесят'; 9: CifrToStr :='девяносто'; 0: CifrToStr :=''; end else if Pr = 3 Then case i of 1: if Padeg =1 Then CifrToStr :='один' else CifrToStr :='одна'; 2: if Padeg =1 Then CifrToStr :='два' else CifrToStr :='две'; 3: CifrToStr :='три'; 4: CifrToStr :='четыре'; 5: CifrToStr :='пять'; 6: CifrToStr :='шесть'; 7: CifrToStr :='семь'; 8: CifrToStr :='восемь'; 9: CifrToStr :='девять'; 0: CifrToStr :=''; end else if Pr = 4 Then case i of 1: CifrToStr :='одиннадцать'; 2: CifrToStr :='двенадцать'; 3: CifrToStr :='тринадцать'; 4: CifrToStr :='четырнадцать'; 5: CifrToStr :='пятнадцать'; 6: CifrToStr :='шестнадцать'; 7: CifrToStr :='семнадцать'; 8: CifrToStr :='восемнадцать'; 9: CifrToStr :='девятнадцать'; 0: CifrToStr :='десять';
end; end;

function Rasryad(K:Integer;V:String) : string;
{Функция возвращает наименование разряда в зависимости от последних 2 цифр его}
Var j:Integer;
Begin
j := StrToInt(Copy(v,Length(v),1)); if (StrToInt(Copy(v,Length(v)-1,2))> 9) And (StrToInt(Copy(v,Length(v)-1,2))< 20) Then case K of 0: Rasryad :=''; 1: Rasryad :='тысяч'; 2: Rasryad :='миллионов'; 3: Rasryad :='миллиардов'; 4: Rasryad :='триллионов'; end else case K of 0: Rasryad :=''; 1: case j of 1: Rasryad :='тысяча'; 2..4: Rasryad :='тысячи'; else Rasryad :='тысяч'; end; 2: case j of 1: Rasryad :='миллион'; 2..4: Rasryad :='миллионa'; else Rasryad :='миллионов'; end; 3: case j of 1: Rasryad :='миллиард'; 2..4: Rasryad :='миллиарда'; else Rasryad :='миллиардов'; end; 4: case j of 1: Rasryad :='триллион'; 2..4: Rasryad :='триллиона'; else Rasryad :='триллионов'; end; end; end;

function GroupToStr(Group:String;Padeg:Integer) : string;
{Функция возвращает прописью 3 цифры}
var i:Integer;
S:String; begin
S:=''; if (StrToInt(Copy(Group,Length(Group)-1,2))> 9) And (StrToInt(Copy(Group,Length(Group)-1,2))< 20) Then begin if Length(Group) = 3 Then S := S+' '+CifrToStr(Copy(Group,1,1),1,Padeg); S := S+' '+CifrToStr(Copy(Group,Length(Group),1),4,Padeg); end else for i:=1 to Length(Group) do S := S+' '+CifrToStr(Copy(Group,i,1),i-Length(Group)+3,Padeg); GroupToStr:=S; end;

{Функция возвращает сумму прописью}
function RubToStr(Rubs:Currency;Rub,Kop:String) : string;
var i,j:Integer;
R,K,S:String; begin
S := CurrToStr(Rubs); S := Trim(S); if Pos(',',S) = 0 Then begin R:= S; K:= '00'; end else begin R:= Copy(S,0,(Pos(',',S)-1)); K:= Copy(S,(Pos(',',S)+1),Length(S)); end;
S :=''; i:= 0; j := 1; While Length(R) >3 Do Begin if i = 1 Then j :=2 else j:=1; S := GroupToStr(Copy(R,Length(R)-2,3),j) +' '+Rasryad(i,Copy(R,Length(R)-2,3))+ ' ' +S; R := Copy(R,1,Length(R)-3); i:=i+1; end; if i = 1 Then j :=2 else j:=1; S := Trim( GroupToStr(R,j)+' '+Rasryad(i,R) + ' ' +S +' '+Rub+' '+K+' '+Kop); S := ANSIUpperCase(Copy(S,1,1)) + Copy(S,2,Length(S)-1); RubToStr := S; end;

[000240]



Содержание раздела