Форум: "Потрепаться";
Текущий архив: 2004.08.15;
Скачать: [xml.tar.bz2];
ВнизКто нибудь знает исходник прог которая отабражает введенные число Найти похожие ветки
← →
Ani © (2004-08-01 10:37) [0]Кто нибудь знает исходник прог которая отабражает введенные число в виде слов
← →
SergP © (2004-08-01 10:46) [1]смотри вчерашнюю рассылку. Там несколько вариантов приведено...
← →
Real © (2004-08-01 10:49) [2]недавно делал соответствующий макрос на экселе (не претендую на лучшее решение, но работает :)))
http://www.ukrdevelop.narod.ru/download/dig2str.zip
← →
Кириешки © (2004-08-01 11:12) [3]НА ВОТ!
function ShortNum(num: word; razr: integer): string;
const
hundreds: array [0..9] of string = ("", " сто", " двести", " триста",
" четыреста", " пятьсот", " шестьсот", " семьсот", " восемьсот",
" девятьсот");
tens: array [0..9] of string = ("", "", " двадцать", " тридцать",
" сорок", " пятьдесят", " шестьдесят", " семьдесят", " восемьдесят",
" девяносто");
ones: array [3..19] of string = (" три", " четыре", " пять", " шесть",
" семь", " восемь", " девять", " десять", " одиннадцать",
" двенадцать", " тринадцать", " четырнадцать", " пятнадцать",
" шестнадцать", " семнадцать", " восемнадцать", " девятнадцать");
razryad: array [0..6] of string = ("", " тысяч", " миллион", " миллиард",
" триллион", " квадриллион", " квинтиллион");
var
t: byte; // десятки
o: byte; // единицы
begin
result := hundreds[num div 100];
if num mod 100 = 0 then Exit;
t := (num mod 100) div 10;
o := num mod 10;
if t <> 1 then begin
result := result + tens[t];
case o of
1: if razr = 1
then result := result + " одна"
else result := result + " один";
2: if razr = 1
then result := result + " две"
else result := result + " два";
3..9: result := result + ones[o];
end;
result := result + razryad[razr];
case o of
1: if razr = 1 then result := result + "а";
2..4: if razr = 1
then result := result + "и"
else if razr > 1 then result := result + "а";
else if razr > 1 then result := result + "ов";
end;
end else begin
result := result + ones[num mod 100];
result := result + razryad[razr];
if razr > 1 then result := result + "ов";
end;
end;
function IntToWords(s: string): string;
var
i, count: integer;
begin
if Length(s) <= 0 then begin
result := "ноль";
Exit;
end;
count := (Length(s) + 2) div 3;
if count > 7 then begin
result := "Value is too large";
Exit;
end;
result := "";
s := "00" + s;
for i := 1 to count do
result := ShortNum(StrToInt(copy(s, Length(s) - 3 * i + 1, 3)), i - 1) + result;
if Length(result) > 0 then delete(result, 1, 1);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
label1.caption := IntToWords(Edit1.Text);
end;
← →
Ani © (2004-08-01 11:14) [4]>>>SergP © (01.08.04 10:46) [1]
А где зто?
← →
Ani © (2004-08-01 11:15) [5]>>>SergP © (01.08.04 10:46) [1]
А где зто?
← →
Ani © (2004-08-01 11:50) [6]Всем спосибо!!!
кстати Я тоже нашел один исходник:
Автор: Раков Андрей, klopmail@mail.ru, Курчатов
Copyright: Раков А.В.
Дата: 17 августа 2002 г.
***************************************************** }
Function MoneyToStr(DD :String):String;
{(С) Раков А.В. 05.2002 e-mail: klopmail@mail.ru сайт: http://www.kursknet.ru/klop}
Type
TTroyka=Array[1..3] of Byte;
TMyString=Array[1..19] of String[12];
Var
S,OutS,S2 :String;
k,L,kk :Integer;
Troyka :TTroyka;
V1 :TMyString;
Mb :Byte;
Const
V11 :TMyString=
("один","два","три","четыре","пять","шесть","семь","восемь","девять","десять","одиннадцать",
"двенадцать","тринадцать","четырнадцать","пятнадцать","шестнадцать","семнадцать","восемнадцать","девятнадцать");
V2 :Array[1..8] of String=
("двадцать","тридцать","сорок","пятьдесят","шестьдесят","семьдесят","восемьдесят","девяносто");
V3 :Array[1..9] of String=
("сто","двести","триста","четыреста","пятьсот","шестьсот","семьсот","восемьсот","девятьсот");
M1 :Array[1..13,1..3] of String=(("тысяча","тысячи","тысяч"),
("миллион","миллиона","миллионов"),
("миллиард","миллиарда","миллиардов"),
("триллион","триллиона","триллионов"),
("квадриллион","квадриллиона","квадриллионов"),
("квинтиллион","квинтиллиона","квинтиллионов"),
("секстиллион","секстиллиона","секстиллионов"),
("сентиллион","сентиллиона","сентиллионов"),
("октиллион","октиллиона","октиллионов"),
("нониллион","нониллиона","нониллионов"),
("дециллион","дециллиона","дециллионов"),
("ундециллион","ундециллиона","ундециллионов"),
("додециллион","додециллиона","додециллионов"));
R1 :Array[1..3] of String=("рубль","рубля","рублей");
R2 :Array[1..3] of String=("копейка","копейки","копеек");
Function TroykaToStr(L :ShortInt;TR :TTroyka):String;
Var
S :String;
Begin
S:="";
if Abs(L)=1 then Begin V1[1]:="одна";V1[2]:="две";end else
Begin V1[1]:="один";V1[2]:="два";end;
if Troyka[2]=1 then Begin Troyka[2]:=0;Troyka[3]:=10+Troyka[3];end;
if Troyka[3]<>0 then S:=V1[Troyka[3]];
if Troyka[2]<>0 then S:=V2[Troyka[2]-1]+" "+S;
if Troyka[1]<>0 then S:=V3[Troyka[1]]+" "+S;
if (L>0) and (S<>"") then Case Troyka[3] of
1: S:=S+" "+M1[L,1]+" ";
2..4: S:=S+" "+M1[L,2]+" ";
else S:=S+" "+M1[L,3]+" ";
end;
TroykaToStr:=S;
End;
Begin
V1:=V11;L:=0;OutS:="";
kk:=Pos(",",DD);
if kk=0 then S:=DD else S:=Copy(DD,1,kk-1);if S="0" then S2:="" else S2:=S;
Repeat
for k:=3 downto 1 do
if Length(S)>0 then
Begin
Troyka[k]:=StrToInt(S[Length(S)]);
Delete(S,Length(S),1);
end else
Troyka[k]:=0;
OutS:=TroykaToStr(L,Troyka)+OutS;
if L=0 then Mb:=Troyka[3];
Inc(L);
Until Length(S)=0;
case Mb of
0:if Length(S2)>0 then OutS:=OutS+" "+R1[3]+" ";
1:OutS:=OutS+" "+R1[1]+" ";
2..4:OutS:=OutS+" "+R1[2]+" ";
else OutS:=OutS+" "+R1[3]+" ";
end;S2:="";
if kk<>0 then
Begin
DD:=Copy(DD,kk+1,2);if Length(DD)=1 then DD:=DD+"0";
k:=StrToInt(DD);
Troyka[1]:=0;Troyka[2]:=k div 10;Troyka[3]:=k mod 10;S2:=TroykaToStr(-1,Troyka);
case Troyka[3] of
0:if Troyka[2]=0 then S:="" else S:=R2[3];
1:S:=R2[1];
2..4:S:=R2[2];
else S:=R2[3];
end;
end;
// MoneyToStr:=OutS+IntToStr(k)+" "+S; // если копейки нужны цифрой-эту строку раскоментировать
MoneyToStr:=OutS+S2+" "+S; // а эту закоментировать
End;
Пример использования:
S:=MoneyToStr("76576876876976576437654365,98");
← →
SergP © (2004-08-01 11:51) [7]
> [5] Ani © (01.08.04 11:15)
> >>>SergP © (01.08.04 10:46) [1]
> А где зто?
Есть рассылка "Мастера DELPHI. Новости мира компонент, FAQ, статьи..." на субскрайбе можешь подписаться....
Но скопировать не могу сюда, так как русские буквы заменяются на "?". Кодировка не та....
← →
Ani © (2004-08-01 12:39) [8]Всем спосибо!!!
кстати Я тоже нашел один исходник:
Автор: Раков Андрей, klopmail@mail.ru, Курчатов
Copyright: Раков А.В.
Дата: 17 августа 2002 г.
***************************************************** }
Function MoneyToStr(DD :String):String;
{(С) Раков А.В. 05.2002 e-mail: klopmail@mail.ru сайт: http://www.kursknet.ru/klop}
Type
TTroyka=Array[1..3] of Byte;
TMyString=Array[1..19] of String[12];
Var
S,OutS,S2 :String;
k,L,kk :Integer;
Troyka :TTroyka;
V1 :TMyString;
Mb :Byte;
Const
V11 :TMyString=
("один","два","три","четыре","пять","шесть","семь","восемь","девять","десять","одиннадцать",
"двенадцать","тринадцать","четырнадцать","пятнадцать","шестнадцать","семнадцать","восемнадцать","девятнадцать");
V2 :Array[1..8] of String=
("двадцать","тридцать","сорок","пятьдесят","шестьдесят","семьдесят","восемьдесят","девяносто");
V3 :Array[1..9] of String=
("сто","двести","триста","четыреста","пятьсот","шестьсот","семьсот","восемьсот","девятьсот");
M1 :Array[1..13,1..3] of String=(("тысяча","тысячи","тысяч"),
("миллион","миллиона","миллионов"),
("миллиард","миллиарда","миллиардов"),
("триллион","триллиона","триллионов"),
("квадриллион","квадриллиона","квадриллионов"),
("квинтиллион","квинтиллиона","квинтиллионов"),
("секстиллион","секстиллиона","секстиллионов"),
("сентиллион","сентиллиона","сентиллионов"),
("октиллион","октиллиона","октиллионов"),
("нониллион","нониллиона","нониллионов"),
("дециллион","дециллиона","дециллионов"),
("ундециллион","ундециллиона","ундециллионов"),
("додециллион","додециллиона","додециллионов"));
R1 :Array[1..3] of String=("рубль","рубля","рублей");
R2 :Array[1..3] of String=("копейка","копейки","копеек");
Function TroykaToStr(L :ShortInt;TR :TTroyka):String;
Var
S :String;
Begin
S:="";
if Abs(L)=1 then Begin V1[1]:="одна";V1[2]:="две";end else
Begin V1[1]:="один";V1[2]:="два";end;
if Troyka[2]=1 then Begin Troyka[2]:=0;Troyka[3]:=10+Troyka[3];end;
if Troyka[3]<>0 then S:=V1[Troyka[3]];
if Troyka[2]<>0 then S:=V2[Troyka[2]-1]+" "+S;
if Troyka[1]<>0 then S:=V3[Troyka[1]]+" "+S;
if (L>0) and (S<>"") then Case Troyka[3] of
1: S:=S+" "+M1[L,1]+" ";
2..4: S:=S+" "+M1[L,2]+" ";
else S:=S+" "+M1[L,3]+" ";
end;
TroykaToStr:=S;
End;
Begin
V1:=V11;L:=0;OutS:="";
kk:=Pos(",",DD);
if kk=0 then S:=DD else S:=Copy(DD,1,kk-1);if S="0" then S2:="" else S2:=S;
Repeat
for k:=3 downto 1 do
if Length(S)>0 then
Begin
Troyka[k]:=StrToInt(S[Length(S)]);
Delete(S,Length(S),1);
end else
Troyka[k]:=0;
OutS:=TroykaToStr(L,Troyka)+OutS;
if L=0 then Mb:=Troyka[3];
Inc(L);
Until Length(S)=0;
case Mb of
0:if Length(S2)>0 then OutS:=OutS+" "+R1[3]+" ";
1:OutS:=OutS+" "+R1[1]+" ";
2..4:OutS:=OutS+" "+R1[2]+" ";
else OutS:=OutS+" "+R1[3]+" ";
end;S2:="";
if kk<>0 then
Begin
DD:=Copy(DD,kk+1,2);if Length(DD)=1 then DD:=DD+"0";
k:=StrToInt(DD);
Troyka[1]:=0;Troyka[2]:=k div 10;Troyka[3]:=k mod 10;S2:=TroykaToStr(-1,Troyka);
case Troyka[3] of
0:if Troyka[2]=0 then S:="" else S:=R2[3];
1:S:=R2[1];
2..4:S:=R2[2];
else S:=R2[3];
end;
end;
// MoneyToStr:=OutS+IntToStr(k)+" "+S; // если копейки нужны цифрой-эту строку раскоментировать
MoneyToStr:=OutS+S2+" "+S; // а эту закоментировать
End;
Пример использования:
S:=MoneyToStr("76576876876976576437654365,98");
← →
default © (2004-08-01 12:45) [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;
Страницы: 1 вся ветка
Форум: "Потрепаться";
Текущий архив: 2004.08.15;
Скачать: [xml.tar.bz2];
Память: 0.51 MB
Время: 0.037 c