Советы по 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 Thencase i of1: CifrToStr :='сто';2: CifrToStr :='двести';3: CifrToStr :='триста';4: CifrToStr :='четыреста';5: CifrToStr :='пятьсот';6: CifrToStr :='шестьсот';7: CifrToStr :='семьсот';8: CifrToStr :='восемьсот';9: CifrToStr :='девятьсот';0: CifrToStr :='';endelse if Pr = 2 Thencase i of1: CifrToStr :='';2: CifrToStr :='двадцать';3: CifrToStr :='тридцать';4: CifrToStr :='сорок';5: CifrToStr :='пятьдесят';6: CifrToStr :='шестьдесят';7: CifrToStr :='семьдесят';8: CifrToStr :='восемьдесят';9: CifrToStr :='девяносто';0: CifrToStr :='';endelse if Pr = 3 Thencase i of1: 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 :='';endelse if Pr = 4 Thencase i of1: 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) Thencase K of0: Rasryad :='';1: Rasryad :='тысяч';2: Rasryad :='миллионов';3: Rasryad :='миллиардов';4: Rasryad :='триллионов';endelsecase K of0: Rasryad :='';1: case j of1: Rasryad :='тысяча';2..4: Rasryad :='тысячи';elseRasryad :='тысяч';end;2: case j of1: Rasryad :='миллион';2..4: Rasryad :='миллионa';elseRasryad :='миллионов';end;3: case j of1: Rasryad :='миллиард';2..4: Rasryad :='миллиарда';elseRasryad :='миллиардов';end;4: case j of1: Rasryad :='триллион';2..4: Rasryad :='триллиона';elseRasryad :='триллионов';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) Thenbeginif Length(Group) = 3 ThenS := S+' '+CifrToStr(Copy(Group,1,1),1,Padeg);S := S+' '+CifrToStr(Copy(Group,Length(Group),1),4,Padeg);endelsefor i:=1 to Length(Group) doS := 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 ThenbeginR:= S;K:= '00';endelsebeginR:= Copy(S,0,(Pos(',',S)-1));K:= Copy(S,(Pos(',',S)+1),Length(S));end;
S :='';i:= 0;j := 1;While Length(R) >3 DoBeginif i = 1 Then j :=2else 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 :=2else 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]



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