Top.Mail.Ru
Мастера DELPHI, Delphi programming community Титульная страница Поиск, карта сайта Написать письмо 
| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL |
| Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

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

функция которая переводит число в слова [D7]


DIS ©   (2004-08-29 10:40:00) 

Мастера, хочу с вами посоветоваться. Ессть функция которая переводит число в слова (1 - один), загвоздка вот в чем: я могу преводить числа только те, которые уже набраны и хранятся для  ComboBox в items, а для memo в lines. А как сделать, чтобы можно было писать в edit или  memo и переводить числа которые в них набираются?
(взял функцию с http://move.to/ahasoft/)

procedure TForm1.FormActivate(Sender: TObject);
var
i,q:integer;
c:currency;
s:string;
begin
ComboBox1.items.beginupdate;
for i:=0 to ComboBox1.items.count-1 do begin
 c:=strtocurrp(ComboBox1.items[i]);
 s:=fs.CurrtoText(c);
 ComboBox1.items[i]:= ' '+s;
end;
ComboBox1.items.endupdate;
end;


DIS   (2004-08-29 12:45:00) [1]

Большое спасибо. А по поводу шутки. Функция была описана отдельно и подключена в uses. Всем спасибо за внимание.


тот же   (2004-08-29 11:41:00) [2]

На форме EditCurrency, Label и кнопка.Если нет CurrencyEdit замени на Edit
unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 StdCtrls, Mask, ToolEdit, CurrEdit;

type
 TForm1 = class(TForm)
   Button1: TButton;
   Label1: TLabel;
   CurrencyEdit1: TCurrencyEdit;
   procedure Button1Click(Sender: TObject);
   procedure FormCreate(Sender: TObject);
   procedure CurrencyEdit1Change(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.DFM}
function SumNumToFull(Number:real):string;
var
 PartNum, TruncNum, NumTMP, D: integer;
 NumStr : string;
 i, R   : byte;
 Flag11 : boolean;
begin
 D:=1000000;
 R:=4;
 TruncNum:=Trunc(Number); //выделяем рубли
 if TruncNum<>0
   then
     repeat
       PartNum:=TruncNum div D;
       Dec(R);
       D:=D div 1000;
     until PartNum<>0
   else
     R:=0;

// перевод рублей
 FOR i:=R DOWNTO 1 DO
 BEGIN
   Flag11:=False;
   NumTMP:=PartNum div 100; {выделение цифры сотен}
   case NumTMP of
     1: NumStr:=NumStr+'сто ';
     2: NumStr:=NumStr+'двести ';
     3: NumStr:=NumStr+'триста ';
     4: NumStr:=NumStr+'четыреста ';
     5: NumStr:=NumStr+'пятьсот ';
     6: NumStr:=NumStr+'шестьсот ';
     7: NumStr:=NumStr+'семьсот ';
     8: NumStr:=NumStr+'восемьсот ';
     9: NumStr:=NumStr+'девятьсот ';
   end;
   NumTMP:=(PartNum mod 100) div 10; {выделение цифры десятков }
   case NumTMP of
     1: begin
          NumTMP:=PartNum mod 100;
          case NumTMP of
           10: NumStr:=NumStr+'десять ';
           11: NumStr:=NumStr+'одиннадцать ';
           12: NumStr:=NumStr+'двенадцать ';
           13: NumStr:=NumStr+'тринадцать ';
           14: NumStr:=NumStr+'четырнадцать ';
           15: NumStr:=NumStr+'пятнадцать ';
           16: NumStr:=NumStr+'шестнадцать ';
           17: NumStr:=NumStr+'семнадцать ';
           18: NumStr:=NumStr+'восемнадцать ';
           19: NumStr:=NumStr+'девятнадцать ';
          end;
          case i of
            3: NumStr:=NumStr+'миллионов ';
            2: NumStr:=NumStr+'тысяч ';
            1: NumStr:=NumStr+'рублей ';
          end;
          Flag11:=True;
        end;
     2: NumStr:=NumStr+'двадцать ';
     3: NumStr:=NumStr+'тридцать ';
     4: NumStr:=NumStr+'сорок ';
     5: NumStr:=NumStr+'пятьдесят ';
     6: NumStr:=NumStr+'шестьдесят ';
     7: NumStr:=NumStr+'семьдесят ';
     8: NumStr:=NumStr+'восемьдесят ';
     9: NumStr:=NumStr+'девяносто ';
   end;
   NumTMP:=PartNum mod 10; {выделение цифры единиц}
   if not Flag11 then
     begin
       case NumTMP of
         1: if i=2 then NumStr:=NumStr+'одна ' else NumStr:=NumStr+'один ';
         2: if i=2 then NumStr:=NumStr+'две ' else NumStr:=NumStr+'два ';
         3: NumStr:=NumStr+'три ';
         4: NumStr:=NumStr+'четыре ';
         5: NumStr:=NumStr+'пять ';
         6: NumStr:=NumStr+'шесть ';
         7: NumStr:=NumStr+'семь ';
         8: NumStr:=NumStr+'восемь ';
         9: NumStr:=NumStr+'девять ';
       end;
       case i of
         3: case NumTMP of
              1    : NumStr:=NumStr+'миллион ';
              2,3,4: NumStr:=NumStr+'миллиона ';
              else NumStr:=NumStr+'миллионов ';
            end;
         2: case NumTMP of
              1    : NumStr:=NumStr+'тысяча ';
              2,3,4: NumStr:=NumStr+'тысячи ';
              else if PartNum<>0 then NumStr:=NumStr+'тысяч ';
            end;
         1: case NumTMP of
              1    : NumStr:=NumStr+'рубль ';
              2,3,4: NumStr:=NumStr+'рубля ';
              else NumStr:=NumStr+'рублей ';
            end;
       end;
     end;
   if i>1 then begin
                PartNum:=(TruncNum mod (D*1000)) div D;
                D:=D div 1000;
               end;
 END;

//перевод копеек
 PartNum:=Round(Frac(Number)*100);
 if PartNum=0 then
   begin
     SumNumToFull:=NumStr+'00 копеек';
     Exit;
   end;
 NumTMP:=PartNum div 10; {выделение цифры десятков }
 if NumTMP=0 then NumStr:=NumStr+'0'+IntToStr(PartNum)+' '
             else NumStr:=NumStr+IntToStr(PartNum)+' ';
 NumTMP:=PartNum mod 10; {выделение цифры единиц}
 case NumTMP of
   1: if PartNum<>11 then NumStr:=NumStr+'копейка'
                     else NumStr:=NumStr+'копеек';
   2,3,4: if (PartNum<5) or (PartNum>14)
             then NumStr:=NumStr+'копейки'
             else NumStr:=NumStr+'копеек';
   else NumStr:=NumStr+'копеек';
 end;
 SumNumToFull:=NumStr;
end;  //---SumNumToFull
procedure TForm1.Button1Click(Sender: TObject);
begin
Label1.Caption:='';
if CurrencyEdit1.Text='' then
  begin
  beep;
  ShowMessage('В поле ввода введите сумму!!!');
  ActiveControl:=CurrencyEdit1;
  exit
  end;
try
StrToFloat(CurrencyEdit1.Text);
except
Beep;
ShowMessage('Не верно введена сумма!');
ActiveControl:=CurrencyEdit1;
Exit
end;
//Label1.Caption:=SumNumToFull(StrToFloat(Edit1.Text));
 Label1.Caption:=SumNumToFull(StrToFloat(CurrencyEdit1.Text));
if StrToFloat(CurrencyEdit1.Text)>=1000000000 then
  begin
  Beep;
  Label1.Caption:='';
  ShowMessage('Максимально допустимая сумма 999999999,99 руб!');
  ActiveControl:=CurrencyEdit1;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
ActiveControl:=CurrencyEdit1;
end;

procedure TForm1.CurrencyEdit1Change(Sender: TObject);
begin
//CurrencyEdit1.Text:=trim(CurrencyEdit1.Text);
Label1.Caption:='';
end;

end.


DiamondShark   (2004-08-29 11:04:00) [3]

Это шутка юмора такая?


Наверх

Титульная страница Поиск, карта сайта Написать письмо