نوشتن اعداد به حروف

سلام

چه طوری میشه وقتی ما یه عدد رو مینویسیم (111111) به حروف در یک قسمت دیگه تایپ شود به صورت اتوماتیک

12134

دوازده هزار و صد و سی و چهار 

جستجو رو فراموش نکنید!

http://www.barnamenevis.org/viewtopic.php?t=2913

مرسی آقا کامبیز :wink:

سلام

من این کد رو تست کردم درست کار میده و لی وقتی می خواهد در یک لیبل تا edit و .. نشان بدهد بر عکس متن را می نویسد
به نظر شما چه دردی داره

راستی اینم یونیت برنامه

unit Unit1;



interface



uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls;



type

  TForm1 = class(TForm)

    Button1: TButton;

    Edit1: TEdit;

    Label_Famil: TLabel;

    procedure Button1Click(Sender: TObject);

  private

{ Private declarations }

  public

    { Public declarations }

  end;



var

  Form1: TForm1;

implementation

{$R *.dfm}



function num2str_pro(w:longint):string;

const

ch1:array[1..9] of string[10]=(' یک',' دو',' سه',' چهار',' پنج',' شش',' هفت',' هشت',' نه');

ch2:array[0..9] of string[10]=(' ده',' یازده',' دوازده',' سیزده¨',' چهارده',' پانزده',' شانزده',' هفده',' هجده',' نوزده');

ch3:array[1..8] of string[10]=(' بیست',' سی',' چهل',' پنجاه',' شصت',' هفتاد',' هشتاد',' نود');

ch4:array[1..9] of string[10]=(' صد',' دویست',' سیصد',' چهارصد',' پانصد',' ششصد',' هفتصد',' هشتصد',' نهصد');

ch5:array[2..4] of string[10]=(' هزار',' میلیون',' میلیارد');

var

org,scr,tem:string;

cont,i:byte;

cone,cten,chan:byte;



function zero(s:string):boolean;

var i:integer;w:word;

begin

if (s='') then zero:=false else zero:=true;

end;

begin

str(w,tem);cont:=0;

while length(tem) mod 3 <> 0 do

tem:='0'+tem;

cont:=length(tem) div 3;

org:='';i:=0;

while true do begin

if i=0 then inc(i) else inc(i,3);

if i>=length(tem) then break;

scr:=Copy(tem,i,3);

cone:=byte(scr[3])-48;

cten:=byte(scr[2])-48;

chan:=byte(scr[1])-48;

scr:='';

if(cone=0)and(cten=0)and(chan=  0) then begin dec(cont);continue;end;

if zero(org) then

  org:=' و '+org;

if (chan<10)and (chan>0) then

  scr:=ch4[chan];

if (zero(scr)) and (cten<>0) then

  scr:=' و '+scr;

if cten=1 then

begin

 if cone<10 then

  scr:=ch2[cone]+scr;

  if (cont>1)and(cont<5) then

   scr:=ch5[cont]+scr;

 org:=scr+org;

 dec(cont);

 Continue;

end;

if (cten<>1)and (cten<10) and (cten>0)then

scr:=ch3[cten-1]+scr;

if (zero(scr)) and (cone <>0) and (cten<>1) then

scr:=' و '+scr;

if (cten<>1)and(cone<10)and&#40  ;cone>0) then

scr:=ch1[cone]+scr;

if (cont>1)and(cont<5) then

scr:=ch5[cont]+scr;

dec(cont);

org:=scr+org;

end;

num2str_pro:=org;

end;



procedure TForm1.Button1Click(Sender: TObject);

Var

 Nu:Longint;

begin

Nu:=StrToInt(Edit1.Text);

Label_Famil.Caption:=(num2str_pro(nu&#  41;);

end;



end.

هر مشکلی بود لطف کنید بفرمایید که فوری هستااااااااااااا :wink:

سلام
این فانکشن رو هم من نوشتم. امیدوارم که بدرد دوستان بخوره. این فانکشن همونطوری که میبینید ورودی Extended داره و اعداد اعشار رو هم میخونه، به همراه ممیز.
پیروز باشید

function AliHgethoroof(i:Extended):string;

const v=' و ';

var

    ok:boolean;

    j: Int64;

  {___________________________________}

  function yekan(y:byte):string;

  begin

    case y of

        0:result:='';

        1:result:='یک';

        2:result:='دو';

        3:result:='سه';

        4:result:='چهار';

        5:result:='پنج';

        6:result:='شش';

        7:result:='هفت';

        8:result:='هشت';

        9:result:='نه';

    enD;

    if result=''then ok:=false else ok:=true;

  end;

  {___________________________________}

  function dahgan(y:byte):string;

  begin

    case y of

        0:result:='';

        1:result:='ده';

        2:result:='بیست';

        3:result:='سی';

        4:result:='چهل';

        5:result:='پنجاه';

        6:result:='شصت';

        7:result:='هفتاد';

        8:result:='هشتاد';

        9:result:='نود';

    enD;

    if result=''then ok:=false else ok:=true;

  end;

  {___________________________________}

  function sadgan(y:byte):string;

  begin

    case y of

        0:result:='';

        1:result:='یکصد';

        2:result:='دویست';

        3:result:='سیصد';

        4:result:='چهارصد';

        5:result:='پانصد';

        6:result:='ششصد';

        7:result:='هفتصد';

        8:result:='هشتصد';

        9:result:='نهصد';

    enD;

    if result=''then ok:=false else ok:=true;

  end;

  {___________________________________}

  function dah(y:byte):string;

  begin

    case y of

        0:result:='';

        10:result:='ده';

        11:result:='یازده';

        12:result:='دوازده';

        13:result:='سیزده';

        14:result:='چهارده';

        15:result:='پانزده';

        16:result:='شانزده';

        17:result:='هفده';

        18:result:='هجده';

        19:result:='نوزده';

    enD;

    if result=''then ok:=false else ok:=true;

  end;

  {___________________________________}

  function seragham(si:smallint):string;

  begin

    result:='';

    result:=sadgan(si div 100);

    if ok then result:=result+v;



    if((si mod 100)div 10)<>1 then begin

        result:=result+dahgan((si mod 100)div 10);

        if ok then result:=result+v;

        result:=result+yekan(si mod 10);

        if not ok then result:=copy(result,1,length(result&#4  1;-3);

    End

    else begin

        result:=result+dah(si mod 100);

    end;

    if result='' then ok:=false else ok:=true;

  end;

  {___________________________________}

const

    I_tr=' تریلیون';

    I_mr=' میلیارد';

    I_ml=' میلیون';

    I_hz=' هزار';



    FloatPoint: array [1..7] of String = (' دهم',' صدم',' هزارم',' ده هزارم'

                                         ,' صد هزارم',' میلیونیم',' ده میلیونیم');

var

    jj: String;

begin

    ok:=false;

    if pos('.',FloatToStr(i)) <> 0 then

        jj := copy( FloatToStr(i),1,pos('.',FloatToStr&#40  ;i))-1)

    else jj := FloatToStr(i);

    j := StrToInt64Def(jj,0);

    result:=seragham(j div 1000000000000);

    if ok then result:=result+I_tr+v;

    result:=result+seragham((j mod 1000000000000)div 1000000000);

    if ok then result:=result+I_mr+v;

    result:=result+seragham((j mod 1000000000)div 1000000);

    if ok then result:=result+I_ml+v;

    result:=result+seragham((j mod 1000000)div 1000);

    if ok then result:=result+I_hz+v;

    result:=result+seragham(j mod 1000);

    if not ok then result:=copy(result,1,length(result&#4  1;-3);



    if pos('.',FloatToStr(i)) <> 0 then begin

        Result := Result + ' ممیز ';

        jj := copy( FloatToStr(i),pos('.',FloatToStr(i  ))+1,100);

        j := StrToInt64Def(jj,0);



        result:=result + seragham(j div 1000000000000);

        if ok then result:=result+I_tr+v;

        result:=result+seragham((j mod 1000000000000)div 1000000000);

        if ok then result:=result+I_mr+v;

        result:=result+seragham((j mod 1000000000)div 1000000);

        if ok then result:=result+I_ml+v;

        result:=result+seragham((j mod 1000000)div 1000);

        if ok then result:=result+I_hz+v;

        result:=result+seragham(j mod 1000);

        if not ok then result:=copy(result,1,length(result&#4  1;-3);



        Result := Result + FloatPoint[length(JJ)];

    end;



    if i=0 then result:='صفر';

end;

SyntaxCheck عزیز ممنونم
کارم راه افتاد
اگه خودت برا مقادیر اعشاری چک کنی ممنون می شم چون error میده
:kiss:

سلام
جان اکثر برنامه های من به این فانکشن گره خورده :wink:. با اینکه اطمینان به عملکردش دارم بنا به درخواست شما باز هم از همینجا فانکشن رو کپی کردم و تست کردم و به من که درست جواب داد. توجه به رنج عدد ورودی که در فانکشن تعریف شده داشته باشید. من نمیدونم شما چه اروری دریافت میکنید اما توجه کنید که این فانکشن اعداد اعشاری تا 7 رقم اعشار رو میتونه بخونه(همونطور که در تعریف FloatPoint میبینید).همینطور در مورد محدودیت تعداد ارقام صحیح که تا تریلیون تعریف شده.اما با کمی تغییر خودتون میتونید در صورت نیاز این محدوده رو افزایش بدید. به هر حال بگید که دقیقا چه ایرادی دریافت میکنید شاید بتونم کمکتون کنم.

علی آقا تشکر :flower:

جیرجیرک جون از چی تشکر می کنی :متفکر:

:D
از شما هم تشکر میکنم علی آقا که باعث و بانی خیر شدی (آخه اسمه سینتکس خان هم علی هستش ) :P

:D

من هم از SyntaxCheck واقعا ممنونم
من که تست کردم عالی بود و هیچ خطایی با مقادیر اعشاری نداشت

دوست عزیزم اقای SyntaxCheck

متشکرم :)

من هم 100٪ کار داد عالی بود
اشتباه از من بود .تایپ کرده بودمstrtoint به جای StrToFloat
خیلی ممنون علی آقا
:kiss: :flower: