Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Потрепаться";
Текущий архив: 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
1-1091342370
DeMoN_Astra
2004-08-01 10:39
2004.08.15
звук в TMenu


6-1084746834
w666w
2004-05-17 02:33
2004.08.15
ПОМОГИТЕ!!! как прикрутить к IEParser у события WebBrowser а


3-1089975996
Pafnuty
2004-07-16 15:06
2004.08.15
распечататка DBGrid


14-1090562370
MBo
2004-07-23 09:59
2004.08.15
Пятница. Большая пачка сложных задачек...


10-1029163463
А. Н. Оним
2002-08-12 18:44
2004.08.15
Версия Kylix для работы с POA





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский