Форум: "Основная";
Текущий архив: 2005.07.25;
Скачать: [xml.tar.bz2];

Вниз

Перевод из числа в стоки! Помогите???   Найти похожие ветки 

← →
Face   (2005-07-09 07:21) [0]

Здравствуйте!!!
Посоветуйте как можно число перевести в строковое значение???
например: "1256" надо заменить на "Тысяча двести пятьдесят шесть"
подскажите плизззз!!!

---

← →
alex-drob   (2005-07-09 07:24) [1]

Компонент ByWords.

---

← →
Face   (2005-07-09 07:35) [2]

О!!! А по подробнее???

---

← →
alex-drob   (2005-07-09 07:37) [3]

Где нашёл не помню, но могу прислать на мыло.

---

← →
Face   (2005-07-09 07:37) [4]

угу, буду признателен!!!

---

← →
Kerk ©   (2005-07-09 08:30) [5]

http://delphibase.spb.ru

---

← →
Igor_thief   (2005-07-09 11:37) [6]

Когда-то писал свою реализацию этого дела. Ничего сложного. Вот тебе один из прикольных вариантов найденых потом в инете.
unit Curr2StrRU;

interface

uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Math;

type
 TMoneyType=(mtUAH,mtRUS,mtUSD,mtEUR);
 TLanguageType=(ltUA,ltRU); // требования банка (по-украински; по-русски)
 TCurr2StrRU = class(TComponent)
 private
   { Private declarations }
   FSumma          : currency;
   FActive         : boolean;
   FMoneyType      : TMoneyType;
   FValue          : string;
   FFullString     : boolean;

   procedure FSetSumma(Summa: currency);
   procedure FSetActive(Active: boolean);
   procedure FSetMoneyType(MoneyType: TMoneyType);
   procedure FSetValue(Value: string);
   procedure FSetFullString(FullString: boolean);

 protected
   { Protected declarations }
 public
   { Public declarations }
   constructor Create(AOwner: TComponent); override;
   destructor Destroy; override;
 published
  property Active       : boolean read FActive write FSetActive;
  property MoneyType    : TMoneyType read FMoneyType write FSetMoneyType;
  property FullString   : boolean read FFullString write FSetFullString;
  property Summa        : Currency read FSumma write FSetSumma;
  property Value        : string read FValue write FSetValue;
 end;

procedure Register;

implementation
//----------------------------------------------------------------------------
procedure TCurr2StrRU.FSetSumma(Summa: currency);
begin
 If Summa >= 0 then begin
   if not FActive then FSumma := Summa
                  else raise Exception.Create("ФИГНЯ! Значение Summa нельзя менять пока Active=True.")

 end else  raise Exception.Create("ФИГНЯ! Значение Summa должно быть в диапазоне от - –922337203685477.58 до
922337203685477.58");
end;
//----------------------------------------------------------------------------
procedure TCurr2StrRU.FSetMoneyType(MoneyType: TMoneyType);
begin
 if FMoneyType <> MoneyType then begin
   if not FActive then  FMoneyType := MoneyType
                  else raise Exception.Create("ФИГНЯ! Значение MoneyType нельзя менять пока Active=True.")
 end;

end;
//----------------------------------------------------------------------------
procedure TCurr2StrRU.FSetFullString(FullString: boolean);
begin
 if FFullString <> FullString then begin
   if not FActive then  FFullString := FullString
                  else raise Exception.Create("ФИГНЯ! Значение FullString нельзя менять пока Active=True.")
 end;

end;
//----------------------------------------------------------------------------
procedure TCurr2StrRU.FSetValue(Value: string);
begin
  if (FValue<>Value) then FValue:=Value;
end;
//----------------------------------------------------------------------------
procedure TCurr2StrRU.FSetActive(Active: boolean);
const Max000 = 6;           {Кол-во триплетов - 000}
     MaxPosition=Max000*3; {Кол-во знаков в числе }

function IIF(i:Boolean; s1,s2 : Char) : Char; overload;
begin
 if i then result:=s1 else result:=s2
end;

function IIF(i:Boolean; s1,s2 : String ) : String; overload;
begin
 if i then result:=s1 else result := s2
end;

function NumToStr(s:String):String;{Возвращает число прописью}
const
 c1000  : array[0..Max000] of string = ("", "тысяч", "миллион", "миллиард", "триллион", "квадраллион", "квинтиллион");
 c1000m : array[0..Max000] of Boolean = (False, True, False, False, False, False, False);
 c1000w : array[0..Max000] of Boolean = (True, True, False, False, False, False, False);
 w : array[False..True,"0".."9"] of String[3] = (("ов "," ","а ","а ","а ","ов ","ов ","ов ","ов ","ов "), (" " ,"а ","и ",
"и ","и "," "," "," "," "," "));

function Num000toStr(S:String;woman:Boolean):String;  //Num000toStr возвращает число для триплета
const
 c100   : array["0".."9"] of string=("","сто "   ,"двести "  ,"триста "  ,"четыреста ","пятьсот ","шестьсот ","семьсот "  ,
"восемьсот "  ,"девятьсот ");
 c10    : array["0".."9"] of string=("","десять ","двадцать ","тридцать ","сорок ","пятьдесят ","шестьдесят ","семьдесят ",
"восемьдесят ","девяносто ");
 c11    : array["0".."9"] of string=("","один","две","три","четыр","пят","шест","сем","восем","девят");
 c1     : array[False..True,"0".."9"]of String=(("","один ","два ","три ","четыре ","пять ","шесть ","семь ","восемь ",
"девять "), ("","одна ","две ","три ","четыре ","пять ","шесть ","семь ","восемь ","девять "));
begin {--------------------------------Num000toStr--------------------------------}
 Result:=c100[s[1]]+iif((s[2]="1") and (s[3]>"0"), c11[s[3]]+"надцать ",c10[s[2]] + c1[woman,s[3]]);
end;  {--------------------------------Num000toStr--------------------------------}

var s000 : String[3];
   isw, isMinus : Boolean;
   i : integer;  //Счётчик триплетов
Begin {--------------------------------NumToStr-----------------------------------}
 Result := ""; i:=0;
 isMinus := (s<>"") and (s[1]="-");
 if isMinus then s := Copy(s, 2, Length(s) - 1);
 while not((i>= Ceil(Length(s)/3)) or (i >= Max000)) do
   begin
     s000:=Copy("00" + s,Length(s)-i*3, 3);
     case MoneyType of
       mtRUS : isw:=c1000m[i]; // рубль - ОН
       mtUSD : isw:=c1000m[i]; // доллар - ОН
       mtEUR : isw:=c1000m[i]; // евро - ОН
       mtUAH : isw:=c1000w[i]; // гривна - ОНА
     end;
     if (i>0) and (s000<>"000") then  // тысячи и т.д.
       Result := c1000[i] + w[isw, iif(s000[2]="1", "0", s000[3])] + Result;
     Result := Num000toStr(s000, isw) + Result;
     Inc(i)
   end;
 if Result = "" then Result := "ноль";
 if isMinus then Result := "минус " + Result;
End;  {--------------------------------NumToStr-----------------------------------}

function RealToRouble(c : Currency):String;
const
 // корень - рубл,  копе
 RUS_root   : array["0".."3"] of string[5] = (" рубл"," копе", " руб.", " коп.");
 RUS_ruble  : array["0".."9"] of string[2] = ("ей","ь","я","я","я","ей","ей","ей","ей","ей");

---

← →
Igor_thief   (2005-07-09 11:37) [7]

 RUS_kopeek : array["0".."9"] of string[3] = ("ек","йка","йки","йки","йки","ек","ек","ек","ек","ек");
 // корень - грив,  копе
 UAH_root   : array["0".."3"] of string[5] = (" грив"," копе"," грн."," коп.");
 UAH_ruble  : array["0".."9"] of string[2] = ("ен","на","ны","ны","ны","ен","ен","ен","ен","ен");
 UAH_kopeek : array["0".."9"] of string[3] = ("ек","йка","йки","йки","йки","ек","ек","ек","ек","ек");
 // корень - доллар,  цент
 USD_root   : array["0".."3"] of string[7] = (" доллар"," цент"," USD"," цент.");
 USD_ruble  : array["0".."9"]of string[2] = ("ов","","а","а","а","ов","ов","ов","ов","ов");
 USD_kopeek : array["0".."9"]of string[3] = ("ов","","а","а","а","ов","ов","ов","ов","ов");
 // корень - евро,  цент
 EUR_root   : array["0".."3"] of string[6] = (" евро"," цент"," EUR"," цент.");
 EUR_ruble  : array["0".."9"]of string[2] = ("","","","","","","","","","");
 EUR_kopeek : array["0".."9"]of string[3] = ("ов","","а","а","а","ов","ов","ов","ов","ов");

function ending(const s:String):Char;
var l : integer;  // С l на 8 байт коротче $50->$48->$3F
begin  // Возвращает индекс окончания
 l := Length(s);
 Result:=iif((l>1) and (s[l-1]="1"), "0", s[l]);
end;

var rub : String[MaxPosition + 3];
   kop : String[2];
begin  {Возвращает число прописью с рублями и копейками}
 Str(c : MaxPosition+3:2, Result);
 if Pos("E",Result)=0 then  // Если число можно представить в строке <>1E+99
   begin
     rub := TrimLeft(Copy(Result, 1, Length(Result) - 3));
     kop := Copy(Result, Length(Result)-1, 2) ;
     case MoneyType of
       mtRUS : if FullString = true then Result := NumToStr(rub) + RUS_root["0"] + RUS_ruble[ending(rub)] + " " + kop +
RUS_root["1"] + RUS_Kopeek[ending(kop)]
               else Result := NumToStr(rub) + RUS_root["2"] + " " + kop + RUS_root["3"];
       mtUAH : if FullString = true then Result := NumToStr(rub) + UAH_root["0"] + UAH_ruble[ending(rub)] + " " + kop +
UAH_root["1"] + UAH_kopeek[ending(kop)]
               else Result := NumToStr(rub) + UAH_root["2"] + " " + kop + UAH_root["3"];
       mtUSD : if FullString = true then Result := NumToStr(rub) + USD_root["0"] + USD_ruble[ending(rub)] + " " + kop +
USD_root["1"] + USD_kopeek[ending(kop)]
               else Result := NumToStr(rub) + USD_root["2"] + " " + kop + USD_root["3"];
       mtEUR : if FullString = true then Result := NumToStr(rub) + EUR_root["0"] + EUR_ruble[ending(rub)] + " " + kop +
EUR_root["1"] + EUR_kopeek[ending(kop)]
               else Result := NumToStr(rub) + EUR_root["2"] + " " + kop + EUR_root["3"];
     end;
     Result := AnsiUpperCase(Result[1]) + Copy(Result, 2, Length(Result) - 1);
   end;
end;

begin
 if FActive<>Active then begin
   FActive:=Active;
   if FActive then FValue := RealToRouble(FSumma)
   else FValue:="";
 end;
end;
//----------------------------------------------------------------------------
procedure Register;
begin
 RegisterComponents("ASKO_DS", [TCurr2StrRU]);
end;
//----------------------------------------------------------------------------
constructor TCurr2StrRU.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
 FSumma := 0;
end;
//----------------------------------------------------------------------------
destructor TCurr2StrRU.Destroy;
begin
 inherited Destroy;
end;
//----------------------------------------------------------------------------

end.

---

← →
SergP ©   (2005-07-09 11:46) [8]

На delphiworld.narod.ru есть около десятка вариантов

---

Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2005.07.25;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.49 MB
Время: 0.01 c