Мастера DELPHI (документация, исходники, скачать)

Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

Перевод из числа в стоки! Помогите??? [D6, Win95/98]

Face © (2005-07-09 07:21:00)
Здравствуйте!!!
Посоветуйте как можно число перевести в строковое значение???
например: "1256" надо заменить на "Тысяча двести пятьдесят шесть"
подскажите плизззз!!!

SergP (2005-07-09 11:46:00) [1]
На delphiworld.narod.ru есть около десятка вариантов

Igor_thief (2005-07-09 11:37:00) [2]
Когда-то писал свою реализацию этого дела. Ничего сложного. Вот тебе один из прикольных вариантов найденых потом в инете.
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:00) [3]
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.

Kerk (2005-07-09 08:30:00) [4]
http://delphibase.spb.ru

alex-drob (2005-07-09 07:37:00) [5]
Где нашёл не помню, но могу прислать на мыло.

Face (2005-07-09 07:37:00) [6]
угу, буду признателен!!!

Face (2005-07-09 07:35:00) [7]
О!!! А по подробнее???

alex-drob (2005-07-09 07:24:00) [8]
Компонент ByWords.

Наверх

	« предыдущая ветвь \| форум \| следующая ветвь »