نمایش نتایج 1 تا 15 از 15

نام تاپیک: نوشتن اعداد به حروف

  1. #1
    کاربر دائمی
    تاریخ عضویت
    بهمن 1381
    پست
    854

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

    سلام

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

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

  2. #2
    کاربر دائمی
    تاریخ عضویت
    مرداد 1382
    محل زندگی
    تهران
    پست
    484
    جستجو رو فراموش نکنید!

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

  3. #3
    کاربر دائمی
    تاریخ عضویت
    بهمن 1381
    پست
    854
    مرسی آقا کامبیز :wink:

  4. #4
    کاربر دائمی
    تاریخ عضویت
    بهمن 1381
    پست
    854
    سلام

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

  5. #5
    کاربر دائمی
    تاریخ عضویت
    بهمن 1381
    پست
    854
    راستی اینم یونیت برنامه

    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:

  6. #6
    سلام
    این فانکشن رو هم من نوشتم. امیدوارم که بدرد دوستان بخوره. این فانکشن همونطوری که میبینید ورودی 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;

  7. #7
    کاربر دائمی
    تاریخ عضویت
    بهمن 1381
    پست
    854
    SyntaxCheck عزیز ممنونم
    کارم راه افتاد
    اگه خودت برا مقادیر اعشاری چک کنی ممنون می شم چون error میده
    :kiss:

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

  9. #9
    کاربر دائمی آواتار jirjirakk
    تاریخ عضویت
    بهمن 1381
    محل زندگی
    wwwroot
    پست
    660
    علی آقا تشکر :flower:

  10. #10
    کاربر دائمی
    تاریخ عضویت
    بهمن 1381
    پست
    854
    جیرجیرک جون از چی تشکر می کنی

  11. #11
    کاربر دائمی آواتار jirjirakk
    تاریخ عضویت
    بهمن 1381
    محل زندگی
    wwwroot
    پست
    660
    :D
    از شما هم تشکر میکنم علی آقا که باعث و بانی خیر شدی (آخه اسمه سینتکس خان هم علی هستش ) :P

  12. #12
    کاربر دائمی آواتار jirjirakk
    تاریخ عضویت
    بهمن 1381
    محل زندگی
    wwwroot
    پست
    660
    :D

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

  14. #14
    دوست عزیزم اقای SyntaxCheck

    متشکرم :)

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

قوانین ایجاد تاپیک در تالار

  • شما نمی توانید تاپیک جدید ایجاد کنید
  • شما نمی توانید به تاپیک ها پاسخ دهید
  • شما نمی توانید ضمیمه ارسال کنید
  • شما نمی توانید پاسخ هایتان را ویرایش کنید
  •