السلام عليكم

لاحظت ان الكثير يبحث عن كود مرن وقوي لعملية التفقيط

اهديكم هذا الكود

طبعا يتكون من 2 function

سأقوم بإرفاق functions في المرفقات

طبعا هذا الكود يقبل لغاية 9999999999999999999999999999999999999999 اي 41 خانة اي ما يعادل

تسعة مائة وتسعة وتسعون فيمتون وتسعة مائة وتسعة وتسعون تسرسليون وتسعة مائة وتسعة وتسعون سرسليون وتسعة مائة وتسعة وتسعون فريليون وتسعة مائة وتسعة وتسعون تريليون وتسعة مائة وتسعة وتسعون مليار وتسعة مائة وتسعة وتسعون مليون وتسعة مائة وتسعة وتسعون ألف وتسعة مائة وتسعة وتسعون

الـ function الاول

CREATE OR REPLACE Function Digits3_Word( nNum Number ) Return Varchar2 IS
vReturn	 Varchar2(500) := NULL;
Digit3	  Number := 0;
i1		  Number := 0;
j1		  Number := 0;
k1		  Number := 0;
nInNum	  Number := 0;
vTemp	   Varchar2(50) := NULL;
Type Digit1Array is table of Varchar2(50);
Type Digit2Array is table of Varchar2(50);
Type Digit3Array is table of Varchar2(50);
--
Digit1Str Digit1Array := Digit1Array('واحد',
							'إثنان',
							'ثلاثة',
							'أربعة',
							'خمسة',
							'ستة',
							'سبعة',
							'ثمانية',
							'تسعة',
							'عشرة',
							'إحدى عشرة',
							'إثنا عشر',
							'ثلاثة عشر',
							'أربعة عشر',
							'خمسة عشر',
							'ستة عشر',
							'سبعة عشر',
							'ثمانية عشر',
							'تسعة عشر'
						   ); 
Digit2Str Digit2Array := Digit2Array('',
							'عشرون',
							'ثلاثون',
							'أربعون',
							'خمسون',
							'ستون',
							'سبعون',
							'ثمانون',
							'تسعون'
						   );
Digit3Str Digit3Array := Digit3Array('مائة',
							'مائتان',
							'ثلاث مائة',
							'أربع مائة',
							'خمس مائة',
							'ست مائة',
							'سبع مائة',
							'ثمان مائة',
							'تسعة مائة'
						   );
Begin
  nInNum := nNum;
  If nInNum>999 Then
	nInNum := 0;
  End If;
  vTemp  := LPAD( To_Char( nInNum ), 3, 0 );
  Digit3 := To_Number( SubStr( vTemp, 1, 1 ) );
  If Digit3>0 Then
	vReturn := Digit3Str( Digit3 );
  End If;
  i1 := To_Number( SubStr( vTemp, 2, 2 ) );
  j1 := To_Number( SubStr( vTemp, 2, 1 ) );
  k1 := To_Number( SubStr( vTemp, 3, 1 ) );
  If Digit3>0 AND (j1>0 OR k1>0) Then
	vReturn := vReturn||' و';
  End If;
  If i1>0 and i1<20 Then
	vReturn := vReturn||Digit1Str(i1);
  End If;
  If j1>=2 Then
	If k1>0 Then
	  vReturn := vReturn||Digit1Str(k1)||' و';
	End If;
	vReturn := vReturn||Digit2Str(j1);
  End If;
  If nInNum=0 Then
	vReturn := 'صفر';
  End If;
  Return vReturn;
End Digits3_Word;

الـ function الثاني

CREATE OR REPLACE Function Tafqeet( nNum Number, vIntegerCurrency Varchar2 := 'دينار', vDecimalCurrency Varchar2 := 'فلــــــــس' ) Return Varchar2 IS
  vReturn   Varchar2(1000);
  nInNum	Number := 0;
  nInteger  Number := 0;
  nDecimal  Number := 0;
  nDecimal_V  varchar2(10) :=null;
  vChar	 Varchar2(100);
  vTemp	 Number := 0;
  Type	NamesArray is table of Varchar2(500);
  NameStr NamesArray := NamesArray ( '',
								  'ألف',
								  'مليون',
								  'مليار',
								  'تريليون',
								  'فريليون',
								  'سرسليون',
								  'تسرسليون',
								  'فيمتون'
								);
Begin
  nInNum   := ABS( nNum );
  nInteger := Trunc( nInNum );
  nDecimal := nInNum - nInteger;
  nDecimal_V:=substr(to_char(nDecimal,'9D9999'),4,3);
  vChar := To_Char( nInteger );
  For I in 1..NameStr.Count Loop
	If vChar is NULL Then
	  Exit;
	End If;
	vTemp := To_Number( SubStr( vChar, (Length( vChar )-2), 3) );
	If vTemp>0 Then
	  vReturn := Digits3_Word( vTemp )||' '||NameStr( I )||' و'||vReturn;
	End If;
	vChar := SubStr( vChar, 1, ( Length( vChar )-3 ) );
  End Loop;
  vReturn := SubStr( vReturn, 1, ( Length( vReturn )-1 ) );
  vReturn := LTrim(RTrim(vReturn));
  If nNum>=1000 and nNum<2000 Then
	vReturn := SubStr( vReturn, 5, Length( vReturn ) );
  End If;
  If nNum>=2000 and nNum<3000 Then
	vReturn := 'ألفان'||SubStr( vReturn, 11, Length( vReturn ) );
  End If;
  If nNum>=3000 and nNum<=10000 Then
	vReturn := SubStr( vReturn,1,(INSTR( vReturn,'ألاف' )-1) )||
				'ألف'||
				SubStr( vReturn, (INSTR( vReturn, 'ألف')+3), Length( vReturn ) );
  End If;
  vReturn := LTrim(RTrim(vReturn));
  If nDecimal>0 Then
  if vDecimalCurrency is  null then
	vReturn := vReturn||' '||vIntegerCurrency||' و فلـــ '|| nDecimal_v || ' ــس'  || ' فقط لا غير';
	else
	vReturn := vReturn||' '||vIntegerCurrency||' و '|| nDecimal_v || ' ' || vDecimalCurrency  || ' فقط لا غير';
	end if;
  Else
	vReturn := vReturn||' '||vIntegerCurrency || ' فقط لا غير';
  End If;
  If nInteger>0 Then
	vReturn := vReturn;
  ElsIf nInteger=0 and nDecimal>0  Then
			   
  if vDecimalCurrency is  null then
  vReturn:=nDecimal;
	vReturn :=  'فلــ '||  nDecimal_v || ' ــس ' || ' فقط لا غير';
	else
	vReturn := nDecimal_v || ' ' || vDecimalCurrency || 'فقط لا غير';
	
	end if;
	else
	
	vReturn:='صفر '||vIntegerCurrency || ' فقط لا غير';
  
  End If;
  Return (LTrim(RTrim(vReturn)));
End Tafqeet;

امثله على طريقة استدعاء عملية التفقيط

select Tafqeet(1524552) from dual;
واحد مليون وخمس مائة وأربعة وعشرون ألف وخمس مائة وإثنان وخمسون دينار فقط لا غير

select Tafqeet(1524552.525) from dual;
واحد مليون وخمس مائة وأربعة وعشرون ألف وخمس مائة وإثنان وخمسون دينار و 525 فلــــــــس فقط لا غير

select Tafqeet(1524552,'ريال','هلله') from dual;
واحد مليون وخمس مائة وأربعة وعشرون ألف وخمس مائة وإثنان وخمسون ريال فقط لا غير

select Tafqeet(1524552.656,'ريال','هلله') from dual;
واحد مليون وخمس مائة وأربعة وعشرون ألف وخمس مائة وإثنان وخمسون ريال و 656 هلله فقط لا غير

select Tafqeet(1524552.658,'دولار','سنت') from dual;
واحد مليون وخمس مائة وأربعة وعشرون ألف وخمس مائة وإثنان وخمسون دولار و 658 سنت فقط لا غير

دمتم بخير

Tafqeet.rar

تم تعديل 8 أغسطس 200916 سنة بواسطة jadquraan

مرحبــــا
شكـــــــــــــــــــــــرا يا حلـــــــــــــــــــــــــــو

العفو اخي
هذا اقل واجب

ماشاءالله..مجهود رائع أخي جاد...
بارك الله فيــــــــك...
تحياتي

بجد تسلم أيدك
ربنا يجزيك خير

جزاك الله عنا كل خير

شكرا جزيلا

السلام عليكم.

جزاك الله خيرا.

تسلم

شكرا على المجهود
و لكن هناك مشكلة بالكود
من 3000 الى 10000 لا يعمل بشكل صحيح

هذا الكود انا استخدمه في انظمتي وهي تتعامل مع مبالغ كبيرة ويتكرر فيها التعامل مع الفترة المحددة من قبلك ولكن لم يشتكي اي من المستفيدين من ذلك

لكن سأتفقده قد يكون يحتوي على خطأ

مشكور على المجهود الرائع

الأخ العزيز الكود فعلا لايعمل مع الأرقام من 3000 الي 10000 كما قال الأخ مشكورا
نرجو مراجعتة

السلام عليكم ورحمة الله وبركاته
بعد التحية
اخي فالله
وفقك الله الى ماتحب ويرضي
مجهود ممتاذ
اخوك فالله

الكود أكثر من رائع يا أخي العزيز
ولكن لايعمل فعلاً من رقم 3000 إلى 10000
أرجو مراجعة هذا الكود

If nNum>=3000 and nNum<=10000 Then
       vReturn := SubStr( vReturn,1,(INSTR( vReturn,'ألاف' )-1) )||
                   'ألف'||
                   SubStr( vReturn, (INSTR( vReturn, 'ألف')+3), Length( vReturn ) );
     End If;

ولي سؤال أنا أريد عندما أكتب 1.20 تكون النتيجة واحد ريال و20 هللة وليس واحد ريال و200 هللة

تم تعديل 7 أكتوبر 200916 سنة بواسطة khatab2010

احسنت اخي يوجد خطأ في الفئة 3000 ولغاية 10000

ولتصحيح الخطأ يرجى استبدال

If nNum>=3000 and nNum<=10000 Then
vReturn := SubStr( vReturn,1,(INSTR( vReturn,'ألاف' )-1) )||
'ألف'||
SubStr( vReturn, (INSTR( vReturn, 'ألف')+3), Length( vReturn ) );
End If; 


بهذا الكود 

If nNum>=3000 and nNum<=19999 Then
       vreturn:= replace(vReturn,'ألف','آلاف') ;
     End If;

ممكن ان تضع لنا الكود بعد التعديل وشكرا لك

ولا يهمك هي الكود

بعد التعديل

CREATE OR REPLACE  Function Digits3_Word( nNum Number ) Return Varchar2 IS
   vReturn     Varchar2(500) := NULL;
   Digit3      Number := 0;
   i1          Number := 0;
   j1          Number := 0;
   k1          Number := 0;
   nInNum      Number := 0;
   vTemp       Varchar2(50) := NULL;
   Type Digit1Array is table of Varchar2(50);
   Type Digit2Array is table of Varchar2(50);
   Type Digit3Array is table of Varchar2(50);
   --
   Digit1Str Digit1Array := Digit1Array('واحد',
                               'إثنان',
                               'ثلاثة',
                               'أربعة',
                               'خمسة',
                               'ستة',
                               'سبعة',
                               'ثمانية',
                               'تسعة',
                               'عشرة',
                               'إحدى عشرة',
                               'إثنا عشر',
                               'ثلاثة عشر',
                               'أربعة عشر',
                               'خمسة عشر',
                               'ستة عشر',
                               'سبعة عشر',
                               'ثمانية عشر',
                               'تسعة عشر'
                              ); 
   Digit2Str Digit2Array := Digit2Array('',
                               'عشرون',
                               'ثلاثون',
                               'أربعون',
                               'خمسون',
                               'ستون',
                               'سبعون',
                               'ثمانون',
                               'تسعون'
                              );
   Digit3Str Digit3Array := Digit3Array('مائة',
                               'مائتان',
                               'ثلاث مائة',
                               'أربع مائة',
                               'خمس مائة',
                               'ست مائة',
                               'سبع مائة',
                               'ثمان مائة',
                               'تسعة مائة'
                              );
   Begin nInNum := nNum;
     If nInNum>999 Then
       nInNum := 0;
     End If;
     vTemp  := LPAD( To_Char( nInNum ), 3, 0 );
     Digit3 := To_Number( SubStr( vTemp, 1, 1 ) );
     If Digit3>0 Then
       vReturn := Digit3Str( Digit3 );
     End If;
     i1 := To_Number( SubStr( vTemp, 2, 2 ) );
     j1 := To_Number( SubStr( vTemp, 2, 1 ) );
     k1 := To_Number( SubStr( vTemp, 3, 1 ) );
     If Digit3>0 AND (j1>0 OR k1>0) Then
       vReturn := vReturn||' و';
     End If;
     If i1>0 and i1<20 Then
       vReturn := vReturn||Digit1Str(i1);
     End If;
     If j1>=2 Then
       If k1>0 Then
         vReturn := vReturn||Digit1Str(k1)||' و';
       End If;
       vReturn := vReturn||Digit2Str(j1);
     End If;
     If nInNum=0 Then
       vReturn := 'صفر';
     End If;
     Return vReturn;
   End Digits3_Word;

CREATE OR REPLACE  Function Tafqeet( nNum Number, vIntegerCurrency Varchar2 := 'دينار', vDecimalCurrency Varchar2 := null ) Return Varchar2 IS
     vReturn   Varchar2(1000);
     nInNum    Number := 0;
     nInteger  Number := 0;
     nDecimal  Number := 0;
     nDecimal_V  varchar2(10) :=null;
     vChar     Varchar2(100);
     vTemp     Number := 0;
     Type    NamesArray is table of Varchar2(500);
     NameStr NamesArray := NamesArray ( '',
                                     'ألف',
                                     'مليون',
                                     'مليار',
                                     'تريليون',
                                     'فريليون',
                                     'سرسليون',
                                     'تسرسليون',
                                     'فيمتون'
                                   );
   Begin nInNum   := ABS( nNum );
     nInteger := Trunc( nInNum );
     nDecimal := nInNum - nInteger;
     nDecimal_V:=substr(to_char(nDecimal,'9D9999'),4,3);
     vChar := To_Char( nInteger );
     For I in 1..NameStr.Count Loop
       If vChar is NULL Then
         Exit;
       End If;
       vTemp := To_Number( SubStr( vChar, (Length( vChar )-2), 3) );
       If vTemp>0 Then
         vReturn := Digits3_Word( vTemp )||' '||NameStr( I )||' و'||vReturn;
       End If;
       vChar := SubStr( vChar, 1, ( Length( vChar )-3 ) );
     End Loop;
     vReturn := SubStr( vReturn, 1, ( Length( vReturn )-1 ) );
     vReturn := LTrim(RTrim(vReturn));
     If nNum>=1000 and nNum<2000 Then
       vReturn := SubStr( vReturn, 5, Length( vReturn ) );
     End If;
     If nNum>=2000 and nNum<3000 Then
       vReturn := ' ألفان '||SubStr( vReturn, 11, Length( vReturn ) );
     End If;
     If nNum>=3000 and nNum<=19999 Then
      /* vReturn := SubStr( vReturn,1,(INSTR( vReturn,' ألاف' )-1) )||
                   ' ألف'||
                   SubStr( vReturn, (INSTR( vReturn, ' ألف')+3), Length( vReturn ) );
                   */
                   vreturn:= replace(vReturn,'ألف','آلاف') ;
     End If;
     vReturn := LTrim(RTrim(vReturn));
     If nDecimal>0 Then
     if vDecimalCurrency is  null then
       vReturn := vReturn||' '||vIntegerCurrency||' و فلـــ '|| nDecimal_v || ' ــس'  || ' فقط لا غير';
       else
       vReturn := vReturn||' '||vIntegerCurrency||' و '|| nDecimal_v || ' ' || vDecimalCurrency  || ' فقط لا غير';
       end if;
     Else
       vReturn := vReturn||' '||vIntegerCurrency || ' فقط لا غير';
     End If;
     If nInteger>0 Then
       vReturn := vReturn;
     ElsIf nInteger=0 and nDecimal>0  Then
                  
     if vDecimalCurrency is  null then
     vReturn:=nDecimal;
       vReturn :=  'فلــ '||  nDecimal_v || ' ــس ' || ' فقط لا غير' ;
       else
       vReturn := nDecimal_v || ' ' || vDecimalCurrency || 'فقط لا غير' ;
       
       end if;
       else
       
       vReturn:='صفر '||vIntegerCurrency || ' فقط لا غير';
     
     End If;
     Return (LTrim(RTrim(vReturn)));
   End Tafqeet;

ايضا الكود في المرفقات

Tafqeet.txt

تم تعديل 7 أكتوبر 200916 سنة بواسطة jadquraan

مشكور يا حبيب

مجهود ممتاز جدا جدا

وربنا يوفقك

تسلم ايديك و تسلم الطفيلة ....

تسلم يا الغالي

اشكرك على هذا الإبداع

أين يحرر الكود ؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟

شكرا عمل جميل والله ، ربنا يوفقك لما فية الخير للاسلام والمسلمين