# Native Code > برنامه نویسی در Delphi >  نوشتن اعداد به حروف

## ali643

سلام

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

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

----------


## Kambiz

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

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

----------


## ali643

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

----------


## ali643

سلام

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

----------


## ali643

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

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class&#40;TForm&#41;
    Button1&#58; TButton;
    Edit1&#58; TEdit;
    Label_Famil&#58; TLabel;
    procedure Button1Click&#40;Sender&#58; TObject&#41;;
  private
&#123; Private declarations &#125;
  public
    &#123; Public declarations &#125;
  end;

var
  Form1&#58; TForm1;
implementation
&#123;$R *.dfm&#125;

function num2str_pro&#40;w&#58;longint&#41;&#58;string;
const
ch1&#58;array&#91;1..9&#93; of string&#91;10&#93;=&#40;' یک',' دو',' سه',' چهار',' پنج',' شش',' هفت',' هشت',' نه'&#41;;
ch2&#58;array&#91;0..9&#93; of string&#91;10&#93;=&#40;' ده',' یازده',' دوازده',' سیزده¨',' چهارده',' پانزده',' شانزده',' هفده',' هجده',' نوزده'&#41;;
ch3&#58;array&#91;1..8&#93; of string&#91;10&#93;=&#40;' بیست',' سی',' چهل',' پنجاه',' شصت',' هفتاد',' هشتاد',' نود'&#41;;
ch4&#58;array&#91;1..9&#93; of string&#91;10&#93;=&#40;' صد',' دویست',' سیصد',' چهارصد',' پانصد',' ششصد',' هفتصد',' هشتصد',' نهصد'&#41;;
ch5&#58;array&#91;2..4&#93; of string&#91;10&#93;=&#40;' هزار',' میلیون',' میلیارد'&#41;;
var
org,scr,tem&#58;string;
cont,i&#58;byte;
cone,cten,chan&#58;byte;

function zero&#40;s&#58;string&#41;&#58;boolean;
var i&#58;integer;w&#58;word;
begin
if &#40;s=''&#41; then zero&#58;=false else zero&#58;=true;
end;
begin
str&#40;w,tem&#41;;cont&#58;=0;
while length&#40;tem&#41; mod 3 &lt;> 0 do
tem&#58;='0'+tem;
cont&#58;=length&#40;tem&#41; div 3;
org&#58;='';i&#58;=0;
while true do begin
if i=0 then inc&#40;i&#41; else inc&#40;i,3&#41;;
if i>=length&#40;tem&#41; then break;
scr&#58;=Copy&#40;tem,i,3&#41;;
cone&#58;=byte&#40;scr&#91;3&#93;&#41;-48;
cten&#58;=byte&#40;scr&#91;2&#93;&#41;-48;
chan&#58;=byte&#40;scr&#91;1&#93;&#41;-48;
scr&#58;='';
if&#40;cone=0&#41;and&#40;cten=0&#41;and&#40;chan=  0&#41; then begin dec&#40;cont&#41;;continue;end;
if zero&#40;org&#41; then
  org&#58;=' و '+org;
if &#40;chan&lt;10&#41;and &#40;chan>0&#41; then
  scr&#58;=ch4&#91;chan&#93;;
if &#40;zero&#40;scr&#41;&#41; and &#40;cten&lt;>0&#41; then
  scr&#58;=' و '+scr;
if cten=1 then
begin
 if cone&lt;10 then
  scr&#58;=ch2&#91;cone&#93;+scr;
  if &#40;cont>1&#41;and&#40;cont&lt;5&#41; then
   scr&#58;=ch5&#91;cont&#93;+scr;
 org&#58;=scr+org;
 dec&#40;cont&#41;;
 Continue;
end;
if &#40;cten&lt;>1&#41;and &#40;cten&lt;10&#41; and &#40;cten>0&#41;then
scr&#58;=ch3&#91;cten-1&#93;+scr;
if &#40;zero&#40;scr&#41;&#41; and &#40;cone &lt;>0&#41; and &#40;cten&lt;>1&#41; then
scr&#58;=' و '+scr;
if &#40;cten&lt;>1&#41;and&#40;cone&lt;10&#41;and&#40  ;cone>0&#41; then
scr&#58;=ch1&#91;cone&#93;+scr;
if &#40;cont>1&#41;and&#40;cont&lt;5&#41; then
scr&#58;=ch5&#91;cont&#93;+scr;
dec&#40;cont&#41;;
org&#58;=scr+org;
end;
num2str_pro&#58;=org;
end;

procedure TForm1.Button1Click&#40;Sender&#58; TObject&#41;;
Var
 Nu&#58;Longint;
begin
Nu&#58;=StrToInt&#40;Edit1.Text&#41;;
Label_Famil.Caption&#58;=&#40;num2str_pro&#40;nu&#  41;&#41;;
end;

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

----------


## SyntaxCheck

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

function AliHgethoroof&#40;i&#58;Extended&#41;&#58;string;
const v=' و ';
var
    ok&#58;boolean;
    j&#58; Int64;
  &#123;___________________________________&#125;
  function yekan&#40;y&#58;byte&#41;&#58;string;
  begin
    case y of
        0&#58;result&#58;='';
        1&#58;result&#58;='یک';
        2&#58;result&#58;='دو';
        3&#58;result&#58;='سه';
        4&#58;result&#58;='چهار';
        5&#58;result&#58;='پنج';
        6&#58;result&#58;='شش';
        7&#58;result&#58;='هفت';
        8&#58;result&#58;='هشت';
        9&#58;result&#58;='نه';
    enD;
    if result=''then ok&#58;=false else ok&#58;=true;
  end;
  &#123;___________________________________&#125;
  function dahgan&#40;y&#58;byte&#41;&#58;string;
  begin
    case y of
        0&#58;result&#58;='';
        1&#58;result&#58;='ده';
        2&#58;result&#58;='بیست';
        3&#58;result&#58;='سی';
        4&#58;result&#58;='چهل';
        5&#58;result&#58;='پنجاه';
        6&#58;result&#58;='شصت';
        7&#58;result&#58;='هفتاد';
        8&#58;result&#58;='هشتاد';
        9&#58;result&#58;='نود';
    enD;
    if result=''then ok&#58;=false else ok&#58;=true;
  end;
  &#123;___________________________________&#125;
  function sadgan&#40;y&#58;byte&#41;&#58;string;
  begin
    case y of
        0&#58;result&#58;='';
        1&#58;result&#58;='یکصد';
        2&#58;result&#58;='دویست';
        3&#58;result&#58;='سیصد';
        4&#58;result&#58;='چهارصد';
        5&#58;result&#58;='پانصد';
        6&#58;result&#58;='ششصد';
        7&#58;result&#58;='هفتصد';
        8&#58;result&#58;='هشتصد';
        9&#58;result&#58;='نهصد';
    enD;
    if result=''then ok&#58;=false else ok&#58;=true;
  end;
  &#123;___________________________________&#125;
  function dah&#40;y&#58;byte&#41;&#58;string;
  begin
    case y of
        0&#58;result&#58;='';
        10&#58;result&#58;='ده';
        11&#58;result&#58;='یازده';
        12&#58;result&#58;='دوازده';
        13&#58;result&#58;='سیزده';
        14&#58;result&#58;='چهارده';
        15&#58;result&#58;='پانزده';
        16&#58;result&#58;='شانزده';
        17&#58;result&#58;='هفده';
        18&#58;result&#58;='هجده';
        19&#58;result&#58;='نوزده';
    enD;
    if result=''then ok&#58;=false else ok&#58;=true;
  end;
  &#123;___________________________________&#125;
  function seragham&#40;si&#58;smallint&#41;&#58;string;
  begin
    result&#58;='';
    result&#58;=sadgan&#40;si div 100&#41;;
    if ok then result&#58;=result+v;

    if&#40;&#40;si mod 100&#41;div 10&#41;&lt;>1 then begin
        result&#58;=result+dahgan&#40;&#40;si mod 100&#41;div 10&#41;;
        if ok then result&#58;=result+v;
        result&#58;=result+yekan&#40;si mod 10&#41;;
        if not ok then result&#58;=copy&#40;result,1,length&#40;result&#4  1;-3&#41;;
    End
    else begin
        result&#58;=result+dah&#40;si mod 100&#41;;
    end;
    if result='' then ok&#58;=false else ok&#58;=true;
  end;
  &#123;___________________________________&#125;
const
    I_tr=' تریلیون';
    I_mr=' میلیارد';
    I_ml=' میلیون';
    I_hz=' هزار';

    FloatPoint&#58; array &#91;1..7&#93; of String = &#40;' دهم',' صدم',' هزارم',' ده هزارم'
                                         ,' صد هزارم',' میلیونیم',' ده میلیونیم'&#41;;
var
    jj&#58; String;
begin
    ok&#58;=false;
    if pos&#40;'.',FloatToStr&#40;i&#41;&#41; &lt;> 0 then
        jj &#58;= copy&#40; FloatToStr&#40;i&#41;,1,pos&#40;'.',FloatToStr&#40  ;i&#41;&#41;-1&#41;
    else jj &#58;= FloatToStr&#40;i&#41;;
    j &#58;= StrToInt64Def&#40;jj,0&#41;;
    result&#58;=seragham&#40;j div 1000000000000&#41;;
    if ok then result&#58;=result+I_tr+v;
    result&#58;=result+seragham&#40;&#40;j mod 1000000000000&#41;div 1000000000&#41;;
    if ok then result&#58;=result+I_mr+v;
    result&#58;=result+seragham&#40;&#40;j mod 1000000000&#41;div 1000000&#41;;
    if ok then result&#58;=result+I_ml+v;
    result&#58;=result+seragham&#40;&#40;j mod 1000000&#41;div 1000&#41;;
    if ok then result&#58;=result+I_hz+v;
    result&#58;=result+seragham&#40;j mod 1000&#41;;
    if not ok then result&#58;=copy&#40;result,1,length&#40;result&#4  1;-3&#41;;

    if pos&#40;'.',FloatToStr&#40;i&#41;&#41; &lt;> 0 then begin
        Result &#58;= Result + ' ممیز ';
        jj &#58;= copy&#40; FloatToStr&#40;i&#41;,pos&#40;'.',FloatToStr&#40;i  &#41;&#41;+1,100&#41;;
        j &#58;= StrToInt64Def&#40;jj,0&#41;;

        result&#58;=result + seragham&#40;j div 1000000000000&#41;;
        if ok then result&#58;=result+I_tr+v;
        result&#58;=result+seragham&#40;&#40;j mod 1000000000000&#41;div 1000000000&#41;;
        if ok then result&#58;=result+I_mr+v;
        result&#58;=result+seragham&#40;&#40;j mod 1000000000&#41;div 1000000&#41;;
        if ok then result&#58;=result+I_ml+v;
        result&#58;=result+seragham&#40;&#40;j mod 1000000&#41;div 1000&#41;;
        if ok then result&#58;=result+I_hz+v;
        result&#58;=result+seragham&#40;j mod 1000&#41;;
        if not ok then result&#58;=copy&#40;result,1,length&#40;result&#4  1;-3&#41;;

        Result &#58;= Result + FloatPoint&#91;length&#40;JJ&#41;&#93;;
    end;

    if i=0 then result&#58;='صفر';
end;

----------


## ali643

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

----------


## SyntaxCheck

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

----------


## jirjirakk

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

----------


## ali643

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

----------


## jirjirakk

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

----------


## jirjirakk

:D

----------


## Delphi KDE

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

----------


## Delphi-Clinic

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

متشکرم  :)

----------


## ali643

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

----------

