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

Вниз

функция которая переводит число в слова   Найти похожие ветки 

← →
DIS   (2004-08-29 10:40) [0]

Мастера, хочу с вами посоветоваться. Ессть функция которая переводит число в слова (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;

---

← →
DiamondShark ©   (2004-08-29 11:04) [1]

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

---

← →
тот же   (2004-08-29 11:41) [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.


---

← →
DIS   (2004-08-29 12:45) [3]

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

---

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

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

Наверх

Память: 0.47 MB
Время: 0.037 c