سوال: می خوام یه عدد بگیر و به فارسی بنویسه

[sajadvahedi]

سلام و خسته نباشید
دو تا سوال دارم
1- می خوام جمع فاکتور برنامم که واسه پروژم به فارسی بنویسه
2- عدد ریاضی جمع فاکتور رو سه رقم سه رقم جدا کنه
خیلی لازمش دارم استادم گیر داده فقط به همین دو تا قسمت.
لطفا کمکم کنید.

[Felony]

جست و جو کن یکی از اعضا یک یونیت برای تبدیل اعداد به حروف قرار داده بود ، در مورد 3 رقم جدا کردن هم که خیلی زیاد بحث شده .

[ar_mokhtari]

در مورد سه رقم جداسازي، فکر ميکنم سريع ترين روش وارد کرد کد 0,### در DisplayFormat فيلدتون توي Query هست. حروف فارسي اعداد هم همون طور که جناب SilverSoft فرمودند توي سايت بچه ها صحبت کردند و هست يک Function هست که ميتونيد استفاده کنيد.

[K.Mohammadreza]

با سلام قبلا هم اينها را گذاشتم ولي دوباره



function GetNumber(Str: String): String;
var
I: Integer;
begin
Result := '';
for I := 1 to Length(Str) do
if(Str[I] in ['0'..'9'])then
Result := Result + Str[I];
end;

function Set3Digit(StrSource: String): String;
var
i, j: Integer;
begin
Result := '';
StrSource := GetNumber(StrSource);
j := 0;
for i := Length(StrSource) downto 1 do
begin
Result := StrSource[i] + Result;
Inc(j);
if((j mod 3) = 0)and(i <> 1)then
Result := ',' + Result;
end;
end;

procedure _3Digit(var MyEdit: TEdit; TNfEditChange: TNotifyEvent);
begin
MyEdit.OnChange := nil;
MyEdit.Text := Set3Digit(MyEdit.Text);
MyEdit.SelStart := Length(MyEdit.Text);
MyEdit.OnChange := TNfEditChange;
end;

procedure CheckNumber(var Key: Char);
begin
if not(key in ['0'..'9', #8])then
Key := #0;
end;

function NReal2Str(Nm: Real; Digit: Integer = 2): String;
var
Num: LongInt;
Fracture: Integer;
Temp: String;
iPos, iDigit: Integer;
begin
Temp := FloatToStr(Nm);
iPos := Pos('.', Temp);
if iPos > 0 then
Temp := RightStr(Temp, (Length(Temp) - iPos))
else
Temp := '';
iDigit := Length(Temp);
if(Digit in [1..3])and(iDigit > 0)then
iDigit := Digit
else
if(iDigit > 3)then
iDigit := 3;
Num := Trunc(Nm);
Temp := '';
if Num > 0 then
begin
Temp := Number2Str(IntToStr(Num));
case iDigit of
1 : begin
Fracture := Round(10 * Frac(Nm));
Temp := Temp + ' و ' + Number2Str(IntToStr(Fracture)) + 'دهم'
end;
2 : begin
Fracture := Round(100 * Frac(Nm));
Temp := Temp + ' و ' + Number2Str(IntToStr(Fracture)) + 'صدم'
end;
3 : begin
Fracture := Round(1000 * Frac(Nm));
Temp := Temp + ' و ' + Number2Str(IntToStr(Fracture)) + 'هزارم'
end;
end;
end;
Result := Temp;
end;

function Number2Str(Nm: string): string;
const
Main: array[1..3,0..9]of string =
(('', 'يكصد و', 'دويست و', 'سيصد و', 'چهارصد و', 'پانصد و', 'ششصد و', 'هفتصد و', 'هشتصد و', 'نهصد و'),
('', '', 'بيست و', 'سي و', 'چهل و', 'پنجاه و', 'شصت و', 'هفتاد و', 'هشتاد و', 'نود و'),
('', 'يك', 'دوو', 'سه', 'چهار', 'پنج', 'شش', 'هفت', 'هشت', 'نه'));
NPos: array[1..4]of string = ('ميليارد و', 'ميليون و', 'هزار و', '');
_10_19: array[10..19]of string =
('ده', 'يازده', 'دوازده', 'سيزده', 'چهارده', 'پانزده', 'شانزده', 'هفده', 'هجده', 'نوزده');
var
TMP2, TMP: string;
Cntr2, Cntr: Integer;
begin
if Length(Nm) > 0 then
begin
Nm := GetNumber(Nm);
case Length(Nm) mod 3 of
1: TMP := '00';
2: TMP := '0';
end;
Nm := TMP + Nm;
TMP := '';
if Length(Nm) <= 3 then
begin
for Cntr := 1 to 3 do
if (Cntr = 2)and(Nm[Cntr] = '1')then
begin
TMP := TMP + _10_19[StrToInt(Copy(Nm, 2, 2))] + ' ';
Break;
end
else
TMP := TMP + Main[Cntr, StrToInt(Nm[Cntr])] + ' ';
TMP := Trim(TMP);
Cntr := Length(TMP);
if TMP <> '' then
if TMP[Cntr] = 'و' then
Delete(TMP, Cntr, 1);
Result := TMP + ' ';
Exit;
end;
Cntr2 := 0;
for Cntr := (4 - (Length(Nm) div 3)) + 1 to 4 do
begin
TMP2 := Number2Str(Copy(Nm, (Cntr2 * 3) + 1, 3));
if Trim(TMP2) <> '' then
TMP := TMP + TMP2 + NPos[Cntr] + ' ';
Inc(Cntr2);
end;
TMP := Trim(TMP);
Cntr := Length(TMP);
if not (Nm[length(NM)] = '2') then
if TMP <> '' then
if TMP[Cntr] = 'و' then
Delete(TMP, Cntr, 1);
Result := TMP;
end
else
Result := '';
end;

[kamran749]

سلام
من کدهایی برای اینکه اعداد را ۳ رقم ، ۳ رقم از هم جدا کند را دارم و همچنین کدهایی برای اینکه اعداد را به صورت حروف بنویسد. و مشکلی هم در استفاده جداگانه آنها ندارم. ولی اگر این دو کد را با هم ادغام کنم ، مشکل پیدا میکند و فقط ۳ رقم اول را حروفی می نویسد و خطا می دهد.لطفا مرا راهنمایی کنید یا کدی برای من بنویسید که در یک ادیت تکست اعداد ۳ رقم ، ۳ رقم از هم جدا شوند و در روی لیبل مقابل آن ، همین اعداد جدا شده به صورت حروفی نوشته شود.

[SayeyeZohor]

http://barnamenevis.org/showthread.php?351074-تبدیل-عدد-به-حروف&highlight=Number2Str

[kamran749]

با سلام قبلا هم اينها را گذاشتم ولي دوباره



function GetNumber(Str: String): String;
var
I: Integer;
begin
Result := '';
for I := 1 to Length(Str) do
if(Str[I] in ['0'..'9'])then
Result := Result + Str[I];
end;

function Set3Digit(StrSource: String): String;
var
i, j: Integer;
begin
Result := '';
StrSource := GetNumber(StrSource);
j := 0;
for i := Length(StrSource) downto 1 do
begin
Result := StrSource[i] + Result;
Inc(j);
if((j mod 3) = 0)and(i <> 1)then
Result := ',' + Result;
end;
end;

procedure _3Digit(var MyEdit: TEdit; TNfEditChange: TNotifyEvent);
begin
MyEdit.OnChange := nil;
MyEdit.Text := Set3Digit(MyEdit.Text);
MyEdit.SelStart := Length(MyEdit.Text);
MyEdit.OnChange := TNfEditChange;
end;

procedure CheckNumber(var Key: Char);
begin
if not(key in ['0'..'9', #8])then
Key := #0;
end;

function NReal2Str(Nm: Real; Digit: Integer = 2): String;
var
Num: LongInt;
Fracture: Integer;
Temp: String;
iPos, iDigit: Integer;
begin
Temp := FloatToStr(Nm);
iPos := Pos('.', Temp);
if iPos > 0 then
Temp := RightStr(Temp, (Length(Temp) - iPos))
else
Temp := '';
iDigit := Length(Temp);
if(Digit in [1..3])and(iDigit > 0)then
iDigit := Digit
else
if(iDigit > 3)then
iDigit := 3;
Num := Trunc(Nm);
Temp := '';
if Num > 0 then
begin
Temp := Number2Str(IntToStr(Num));
case iDigit of
1 : begin
Fracture := Round(10 * Frac(Nm));
Temp := Temp + ' و ' + Number2Str(IntToStr(Fracture)) + 'دهم'
end;
2 : begin
Fracture := Round(100 * Frac(Nm));
Temp := Temp + ' و ' + Number2Str(IntToStr(Fracture)) + 'صدم'
end;
3 : begin
Fracture := Round(1000 * Frac(Nm));
Temp := Temp + ' و ' + Number2Str(IntToStr(Fracture)) + 'هزارم'
end;
end;
end;
Result := Temp;
end;

function Number2Str(Nm: string): string;
const
Main: array[1..3,0..9]of string =
(('', 'يكصد و', 'دويست و', 'سيصد و', 'چهارصد و', 'پانصد و', 'ششصد و', 'هفتصد و', 'هشتصد و', 'نهصد و'),
('', '', 'بيست و', 'سي و', 'چهل و', 'پنجاه و', 'شصت و', 'هفتاد و', 'هشتاد و', 'نود و'),
('', 'يك', 'دوو', 'سه', 'چهار', 'پنج', 'شش', 'هفت', 'هشت', 'نه'));
NPos: array[1..4]of string = ('ميليارد و', 'ميليون و', 'هزار و', '');
_10_19: array[10..19]of string =
('ده', 'يازده', 'دوازده', 'سيزده', 'چهارده', 'پانزده', 'شانزده', 'هفده', 'هجده', 'نوزده');
var
TMP2, TMP: string;
Cntr2, Cntr: Integer;
begin
if Length(Nm) > 0 then
begin
Nm := GetNumber(Nm);
case Length(Nm) mod 3 of
1: TMP := '00';
2: TMP := '0';
end;
Nm := TMP + Nm;
TMP := '';
if Length(Nm) <= 3 then
begin
for Cntr := 1 to 3 do
if (Cntr = 2)and(Nm[Cntr] = '1')then
begin
TMP := TMP + _10_19[StrToInt(Copy(Nm, 2, 2))] + ' ';
Break;
end
else
TMP := TMP + Main[Cntr, StrToInt(Nm[Cntr])] + ' ';
TMP := Trim(TMP);
Cntr := Length(TMP);
if TMP <> '' then
if TMP[Cntr] = 'و' then
Delete(TMP, Cntr, 1);
Result := TMP + ' ';
Exit;
end;
Cntr2 := 0;
for Cntr := (4 - (Length(Nm) div 3)) + 1 to 4 do
begin
TMP2 := Number2Str(Copy(Nm, (Cntr2 * 3) + 1, 3));
if Trim(TMP2) <> '' then
TMP := TMP + TMP2 + NPos[Cntr] + ' ';
Inc(Cntr2);
end;
TMP := Trim(TMP);
Cntr := Length(TMP);
if not (Nm[length(NM)] = '2') then
if TMP <> '' then
if TMP[Cntr] = 'و' then
Delete(TMP, Cntr, 1);
Result := TMP;
end
else
Result := '';
end;



سلام
لطفا طريقه استفاده آن را براي دلفيXE3 هم بنويسيد.ضمنا زير مواردي مثل Number2Str ، GetNumber و ... خط زير نويس خطا مي دهد.
ممنون

[SayeyeZohor]

unit num2char;

interface
uses SysUtils;

const
yekan : array[0..9] of string = ('صفر','يک','دو','سه','چهار','پنج' ,'شش','هفت','هشت','نه');
dahgan : array[0..9] of string = ('','','بيست','سي','چهل','پنجاه','ش صت','هفتاد','هشتاد','نود');
dahyek : array[10..19] of string = ('ده','يازده','دوازده','سيزده',' چهارده','پانزده','شانزده','هف� �� �ه','هجده','نوزده');
sadgan : array[0..9] of string = ('','يکصد','دويست','سيصد','چهارص د','پانصد','ششصد','هفتصد','هشتص د','نهصد');
base : array[0..4] of string = ('','هزار','ميليون','ميليارد','ت ريليون');

function AddComma(snum : string) : string;
function GetStr(snum : string) : string;

implementation

// تابع اعتبار سنجي عدد
function isvalid15(snum : string) : boolean;
var
i, l : integer;
b : boolean;
begin
b := true;
l := length(snum);
if l > 15 then
b := false
else
for i := 1 to l do
if not(snum[i] in ['0'..'9']) then
b := false;
result := b;
end;

// تابع تبديل عدد به حروف
function num2str(snum : string) : string;
// تابع تبد?ل عدد سه رقم? به حروف
function getnum3(num3 : integer) : string;
var
s : string;
d1, d2, d3, d12 : integer;
begin
d12 := num3 mod 100; // دو رقم اول
d3 := num3 div 100; // صدگان
if d3 <> 0 then
s := sadgan[d3] + ' و ';
// نام گذاري اعداد 10 تا 19 در بين
// اعداد دو رقمي استثنا است
if (d12 >= 10) and (d12 <= 19) then
begin
s := s + dahyek[d12];
end
else
begin
d2 := d12 div 10; // دهگان
if d2 <> 0 then
s := s + dahgan[d2] + ' و ';
d1 := d12 mod 10; // يکان
if d1 <> 0 then
s := s + yekan[d1] + ' و ';
// حذف حرف <و> اضافي
s := copy(s, 1, length(s) - 3);
end;
getnum3 := s;
end;

var
L, i, b : integer;
stotal : string;
begin
// اگر عدد صفر بود، يکراست نتيجه را برگردان
if snum = '0' then
result := yekan[0]
else
begin
// براي اينکه بتوان عدد را به قسمت هاي سه رقمي تقسيم کرد
// به سمت چپ عدد، به اندازه کافي صفر مي افزاييم
for i := Length(snum) to ((Length(snum) - 1) div 3 + 1) * 3 - 1 do
snum := '0' + snum;

L := Length(snum) div 3 - 1; // تعداد قسمت هاي سه رقمي منهاي يک

// سه رقم سه رقم حلقه را تکرار کن
// از چپ به راست
for i := 0 to L do
begin
// به دست آوردن سه رقم مورد نظر
b := strtoint(copy(snum ,i * 3 + 1, 3));
// اگر سه رقم به دست آمده صفر باشد، در نام عدد تاثيري ندارد
// نام قسمت سه رقمي را بدست مي آوريمgetnum3 با استفاده از تابع
// پسوند را به آن اضافه مي کنيمbase با استفاده از آرايه
if b <> 0 then
stotal := stotal + getnum3(b) + ' ' + base[L - i] + ' و ';
end;
// حذف حرف <و> اضافي
stotal := copy(stotal, 1, length(stotal) - 3);
result := stotal;
end;
end;

// اين تابع، يک لايه براي تابع <تبديل عدد به حروف> است که صحت مقدار ورودي را نيز بررسي مي کند
function GetStr(snum : string) : string;
begin
snum := trim(snum);
if isvalid15(snum) then
result := num2str(snum)
else
result := 'عدد مورد نظر بسيار بزرگ است و يا معتبر نيست' ;
end;

// *****************************
// *****************************
// *****************************
// تابع افزودن ويرگول
// اين تابع يک عدد مي گيرد و به ازاي هر سه رقم يک ويرگول بين اعداد قرار مي دهد
function AddComma(snum : string) : string;
var
l, i : integer;
s : string;
begin
i := 1;
l := length(snum);
while i <= l do
begin
s := snum[l - i + 1] + s;
if (i mod 3 = 0) and (i <> l) then
s := ',' + s;
i := i + 1;
end;
result := s;
end;

end.


ابتدا یک یونیت به نام num2char ایجاد کنید و بعد این یونیت رو در فرم هاتون use کنید و از فانکشن ان به شکل زیر استفاده کنید


1- می خوام جمع فاکتور برنامم که واسه پروژم به فارسی بنویسه

str := num2str(num);


2- عدد ریاضی جمع فاکتور رو سه رقم سه رقم جدا کنه
strcomma := AddComma(strWithoutComma);

[kamran749]

سلام
من اين يونيت را دارم . همانطور که در بالا گفتم ، مي خواهم روي يک فرم ، یک ادیت تکست داشته باشم که وقتي اعداد را داخل آن مي نويسم ،اين اعداد ۳ رقم ، ۳ رقم از هم جدا شوند و در روی لیبل مقابل آن ، اعداد به صورت حروفی نوشته شود.
ممنون مي شوم اگر برايم چنين کدي بنويسي.:لبخندساده:

[SayeyeZohor]

من اين يونيت را دارم . همانطور که در بالا گفتم ، مي خواهم روي يک فرم ، یک ادیت تکست داشته باشم که وقتي اعداد را داخل آن مي نويسم ،اين اعداد ۳ رقم ، ۳ رقم از هم جدا شوند و در روی لیبل مقابل آن ، اعداد به صورت حروفی نوشته شود.
ممنون مي شوم اگر برايم چنين کدي بنويسي


يك كم دقت كني مي بيني كه همين رو در پست بالا نوشتم

label1.Caption := Num2str(Edit1.text);

اين كد رو در متد Edit2.onexit بنويس
Edit2.text := AddComma(Edit2.text);

[kamran749]

سلام
از اين که زحمت کشيده و راهنمايي مي نماييد واقعا از شما ممنونم.
آيا نمي شود اين کد جدا شدن اعداد در اديت چنچ باشد تا همزمان با تايپ، اعداد از هم جدا شوند و روبروي آن در ليبل به صورت حروف باشد؟
باز هم متشکر:تشویق: