الفريق العربي للبرمجةأرشيف المنتديات · 2000 – 2023
نسخة أرشيفية للقراءة فقط — التسجيل والمشاركة مغلقان، والمحتوى محفوظ كما كان.

التفقيط

بدأه ahmed amer في 3 أبريل 2010 · 9 رد · 2,873 مشاهدة · في قواعد بيانات Visual FoxPro
مشاركة: واتساب X فيسبوك تيليجرام
#1 صاحب الموضوع

الأخوة الأفاضل

السلام عليكم ورحمة الله وبركاته

أرجوا المساعدة يوجد لدي خطاء في عملية التفقيط حيث أن الأخ مصطفة تفضل مشكورا بالمساعدة في تكوين الكود الخاص بالتفقيط ولكن يوجد خطاء عند كتابة الرقم 21000 الف حيث يكون التفقيط مثل العربي كالأتي واحد وعشرون الف لا غير وبما أن الإنجليزية يكون التفقيط بها كالأتي عشرون وواحد ومرفق لكم الكود مع صورة بالخطاء مع الملفات .

اقتباس

chi.rar

تم تعديل هذه المشاركة بواسطة ahmed amer في 3 أبريل 2010 في 12:28

#2

اخى احمد

مرفق برنامج التفقيط وجدته فى المنتدى وهو يشتغل عندى تمام

إن شاء الله تستفيد منه

اخوك ابوعبدالرحمن من ليبيا

tfket.rar

#3

السلام عليكم ورحمة الله وبركاته

أخي الفاضل ابو عبد الرحمن شكراً لكم على إهتمامكم والمساعدة ولكني اخي ابو عبد الرحمن كنت اود حل المشكله التي تواجهني وهي المنحصرة من عند الرقم 21000 وحتي 99000 حيث انها تكون بنفس الطريقه العربيه

ولكم جزيل الشكر

#4

رجوا المساعدة يوجد لدي خطاء في عملية التفقيط حيث أن الأخ مصطفى تفضل مشكورا بالمساعدة في تكوين الكود الخاص بالتفقيط ولكن يوجد خطاء عند كتابة الرقم 21000 الف حيث يكون التفقيط مثل العربي كالأتي واحد وعشرون الف لا غير وبما أن الإنجليزية يكون التفقيط بها كالأتي عشرون وواحد ومرفق لكم الكود مع صورة بالخطاء مع الملفات .

تم تعديل هذه المشاركة بواسطة ahmed amer في 9 أبريل 2010 في 11:23

#5

اتمنى الرد

#6
ahmed amer كتب:

اتمنى الرد

الأخوه الأفاضل

السلام عليكم ورحمة الله وبركاته

تواجهني مشكلة في تفقيط الرقم من 21 والف وحتى 99 الف يعني بيكون الرقم مثل العربي في التفقيط كمثال في العربي51075 " ,واحد وعشرون الف وسبعة وخمسون لاغير " اما المشكلة التي تواجهني وهي التفقيط باللغة الإنجليزية بيكون الآتي " واحد وعشرون الف وسبعة وخمسون لاغير " مثل العربي وانا اريد " خمسون وواحد الف ووخمسون وسبعة لاغير " FIFTY ONE THOUSAND AND FIFTY SEVEN ONLY "

ولكم جزيل الشكر

#7

السلام عليكم

جرب الكود التالي من MSDN

التحويل للغة الانجليزية وهو خاص بالدولار وكل ما عليك هو اجراء القليل من التعديلات لتحويله للعملة التي ترغب بها

chi-new.rar

*FUNCTION ConvertCurrencyToEnglish
LPARAMETERS tNumToConvert

LOCAL Temp
LOCAL NumToConvert
LOCAL cDollars, cCents
LOCAL nDecimalPlace, nCount
LOCAL ARRAY aPlace[9]

DO CASE
CASE EMPTY(tNumToConvert)
	NumToConvert = "0"
CASE TYPE("tNumToConvert") = "N"  && Convert to positive character string
	*!*	Check to see if the number is too big for VFP.  If the number is too large, exit
	IF tNumToConvert > 9999999999999.99
		RETURN "**,***,***,***,***.**"
	ENDIF
	* Convert tnNumToConvert to a positive string, trimming extra spaces.
	NumToConvert = ALLTRIM(STR(ABS(tNumToConvert), 16, 2))
OTHERWISE  && Parameter is character based, make sure it is not negative.
	* Convert the number to a positive number.
	NumToConvert = IIF(LEFT(ALLTRIM(tNumToConvert), 1) = "-", SUBSTR(ALLTRIM(tNumToConvert), 2), ALLTRIM(tNumToConvert))
ENDCASE

* Find decimal place.
nDecimalPlace = AT(".", NumToConvert)

STORE "" TO cDollars, cCents, Result

aPlace = ""
aPlace[2] = " Thousand "
aPlace[3] = " Million "
aPlace[4] = " Billion "
aPlace[5] = " Trillion "
aPlace[6] = " Quadrillion "
aPlace[7] = " Quintillion "
aPlace[8] = " Sextillion "
aPlace[9] = " Septillion "


* If you find decimal place...
IF nDecimalPlace > 0
	* Convert cents
	Temp = LEFT(SUBSTR(NumToConvert, nDecimalPlace + 1) + "00", 2)
	cCents = ConvertTens(Temp)

	* Strip off cents from remainder to convert.
	NumToConvert = ALLTRIM(LEFT(NumToConvert, nDecimalPlace - 1))
ENDIF

nCount = 1
DO WHILE NOT NumToConvert == ""
	* Convert last 3 digits of NumToConvert to English dollars.
	Temp = ConvertHundreds(RIGHT(NumToConvert, 3))
	IF NOT Temp == ""
		cDollars = Temp + aPlace[nCount] + cDollars
	ENDIF
	IF LEN(NumToConvert) > 3 Then
		* Remove last 3 converted digits from NumToConvert.
		NumToConvert = LEFT(NumToConvert, LEN(NumToConvert) - 3)
	ELSE
		NumToConvert = ""
	ENDIF
	nCount = nCount + 1
ENDDO

* Clean up dollars.
DO CASE
CASE cDollars == ""
	cDollars = "No Dollars"
CASE cDollars == "One"
	cDollars = "One Dollar"
OTHERWISE
	cDollars = cDollars + " Dollars"
ENDCASE

* Clean up cents.
DO CASE
CASE cCents == ""
	cCents = " And No Cents"
CASE cCents == "One"
	cCents = " And One Cent"
OTHERWISE
	cCents = " And " + cCents + " Cents"
ENDCASE

ConvertCurrencyToEnglish = cDollars + cCents
RETURN ConvertCurrencyToEnglish
ENDFUNC

FUNCTION ConvertHundreds
	LPARAMETERS NumToConvert
	LOCAL Result
	Result = ""

	* Exit if there is nothing to convert.
	IF VAL(NumToConvert) = 0
		RETURN Result
	ENDIF

	* Append leading zeros to number.
	NumToConvert = RIGHT("000" + NumToConvert, 3)

	* Do you have a hundreds place digit to convert?'
	IF LEFT(NumToConvert, 1) <> "0" Then
		Result = ConvertDigit(LEFT(NumToConvert, 1)) + " Hundred "
	ENDIF

	* Do you have a tens place digit to convert?'
	IF SUBSTR(NumToConvert, 2, 1) <> "0" Then
		Result = Result + ConvertTens(SUBSTR(NumToConvert, 2))
	ELSE
		* If not, then convert the ones place digit.
		Result = Result + ConvertDigit(SUBSTR(NumToConvert, 3))
	ENDIF

	ConvertHundreds = ALLTRIM(Result)
	RETURN ConvertHundreds
ENDFUNC

FUNCTION ConvertTens
	LPARAMETERS MyTens
	LOCAL Result
	Result = ""

	* Is value between 10 and 19?'
	IF VAL(LEFT(MyTens, 1)) = 1
		DO CASE
		CASE VAL(MyTens) = 10
			Result = "Ten"
		CASE VAL(MyTens) = 11
			Result = "Eleven"
		CASE VAL(MyTens) = 12
			Result = "Twelve"
		CASE VAL(MyTens) = 13
			Result = "Thirteen"
		CASE VAL(MyTens) = 14
			Result = "Fourteen"
		CASE VAL(MyTens) = 15
			Result = "Fifteen"
		CASE VAL(MyTens) = 16
			Result = "Sixteen"
		CASE VAL(MyTens) = 17
			Result = "Seventeen"
		CASE VAL(MyTens) = 18
			Result = "Eighteen"
		CASE VAL(MyTens) = 19
			Result = "Nineteen"
		OTHERWISE
		ENDCASE
	ELSE
		* .. otherwise it's BETWEEN 20 AND 99.
		DO CASE
		CASE VAL(LEFT(MyTens, 1)) = 2
			Result = "Twenty "
		CASE VAL(LEFT(MyTens, 1)) = 3
			Result = "Thirty "
		CASE VAL(LEFT(MyTens, 1)) = 4
			Result = "Forty "
		CASE VAL(LEFT(MyTens, 1)) = 5
			Result = "Fifty "
		CASE VAL(LEFT(MyTens, 1)) = 6
			Result = "Sixty "
		CASE VAL(LEFT(MyTens, 1)) = 7
			Result = "Seventy "
		CASE VAL(LEFT(MyTens, 1)) = 8
			Result = "Eighty "
		CASE VAL(LEFT(MyTens, 1)) = 9
			Result = "Ninety "
		OTHERWISE
		ENDCASE

		* Convert ones place digit.
		Result = Result + ConvertDigit(RIGHT(MyTens, 1))
	ENDIF
	ConvertTens = Result
	RETURN ConvertTens
ENDFUNC

FUNCTION ConvertDigit
	LPARAMETERS MyDigit
	DO CASE
	CASE VAL(MyDigit) = 1
		ConvertDigit = "One"
	CASE VAL(MyDigit) = 2
		ConvertDigit = "Two"
	CASE VAL(MyDigit) = 3
		ConvertDigit = "Three"
	CASE VAL(MyDigit) = 4
		ConvertDigit = "Four"
	CASE VAL(MyDigit) = 5
		ConvertDigit = "Five"
	CASE VAL(MyDigit) = 6
		ConvertDigit = "Six"
	CASE VAL(MyDigit) = 7
		ConvertDigit = "Seven"
	CASE VAL(MyDigit) = 8
		ConvertDigit = "Eight"
	CASE VAL(MyDigit) = 9
		ConvertDigit = "Nine"
	OTHERWISE
		ConvertDigit = ""
	ENDCASE
	RETURN ConvertDigit
ENDFUNC

أستغفر الله العظيم و أتوب إليه

#8
Shadowz كتب:

السلام عليكم

جرب الكود التالي من MSDN

التحويل للغة الانجليزية وهو خاص بالدولار وكل ما عليك هو اجراء القليل من التعديلات لتحويله للعملة التي ترغب بها

chi-new.rar

*FUNCTION ConvertCurrencyToEnglish
LPARAMETERS tNumToConvert

LOCAL Temp
LOCAL NumToConvert
LOCAL cDollars, cCents
LOCAL nDecimalPlace, nCount
LOCAL ARRAY aPlace[9]

DO CASE
CASE EMPTY(tNumToConvert)
	NumToConvert = "0"
CASE TYPE("tNumToConvert") = "N"  && Convert to positive character string
	*!*	Check to see if the number is too big for VFP.  If the number is too large, exit
	IF tNumToConvert > 9999999999999.99
		RETURN "**,***,***,***,***.**"
	ENDIF
	* Convert tnNumToConvert to a positive string, trimming extra spaces.
	NumToConvert = ALLTRIM(STR(ABS(tNumToConvert), 16, 2))
OTHERWISE  && Parameter is character based, make sure it is not negative.
	* Convert the number to a positive number.
	NumToConvert = IIF(LEFT(ALLTRIM(tNumToConvert), 1) = "-", SUBSTR(ALLTRIM(tNumToConvert), 2), ALLTRIM(tNumToConvert))
ENDCASE

* Find decimal place.
nDecimalPlace = AT(".", NumToConvert)

STORE "" TO cDollars, cCents, Result

aPlace = ""
aPlace[2] = " Thousand "
aPlace[3] = " Million "
aPlace[4] = " Billion "
aPlace[5] = " Trillion "
aPlace[6] = " Quadrillion "
aPlace[7] = " Quintillion "
aPlace[8] = " Sextillion "
aPlace[9] = " Septillion "


* If you find decimal place...
IF nDecimalPlace > 0
	* Convert cents
	Temp = LEFT(SUBSTR(NumToConvert, nDecimalPlace + 1) + "00", 2)
	cCents = ConvertTens(Temp)

	* Strip off cents from remainder to convert.
	NumToConvert = ALLTRIM(LEFT(NumToConvert, nDecimalPlace - 1))
ENDIF

nCount = 1
DO WHILE NOT NumToConvert == ""
	* Convert last 3 digits of NumToConvert to English dollars.
	Temp = ConvertHundreds(RIGHT(NumToConvert, 3))
	IF NOT Temp == ""
		cDollars = Temp + aPlace[nCount] + cDollars
	ENDIF
	IF LEN(NumToConvert) > 3 Then
		* Remove last 3 converted digits from NumToConvert.
		NumToConvert = LEFT(NumToConvert, LEN(NumToConvert) - 3)
	ELSE
		NumToConvert = ""
	ENDIF
	nCount = nCount + 1
ENDDO

* Clean up dollars.
DO CASE
CASE cDollars == ""
	cDollars = "No Dollars"
CASE cDollars == "One"
	cDollars = "One Dollar"
OTHERWISE
	cDollars = cDollars + " Dollars"
ENDCASE

* Clean up cents.
DO CASE
CASE cCents == ""
	cCents = " And No Cents"
CASE cCents == "One"
	cCents = " And One Cent"
OTHERWISE
	cCents = " And " + cCents + " Cents"
ENDCASE

ConvertCurrencyToEnglish = cDollars + cCents
RETURN ConvertCurrencyToEnglish
ENDFUNC

FUNCTION ConvertHundreds
	LPARAMETERS NumToConvert
	LOCAL Result
	Result = ""

	* Exit if there is nothing to convert.
	IF VAL(NumToConvert) = 0
		RETURN Result
	ENDIF

	* Append leading zeros to number.
	NumToConvert = RIGHT("000" + NumToConvert, 3)

	* Do you have a hundreds place digit to convert?'
	IF LEFT(NumToConvert, 1) <> "0" Then
		Result = ConvertDigit(LEFT(NumToConvert, 1)) + " Hundred "
	ENDIF

	* Do you have a tens place digit to convert?'
	IF SUBSTR(NumToConvert, 2, 1) <> "0" Then
		Result = Result + ConvertTens(SUBSTR(NumToConvert, 2))
	ELSE
		* If not, then convert the ones place digit.
		Result = Result + ConvertDigit(SUBSTR(NumToConvert, 3))
	ENDIF

	ConvertHundreds = ALLTRIM(Result)
	RETURN ConvertHundreds
ENDFUNC

FUNCTION ConvertTens
	LPARAMETERS MyTens
	LOCAL Result
	Result = ""

	* Is value between 10 and 19?'
	IF VAL(LEFT(MyTens, 1)) = 1
		DO CASE
		CASE VAL(MyTens) = 10
			Result = "Ten"
		CASE VAL(MyTens) = 11
			Result = "Eleven"
		CASE VAL(MyTens) = 12
			Result = "Twelve"
		CASE VAL(MyTens) = 13
			Result = "Thirteen"
		CASE VAL(MyTens) = 14
			Result = "Fourteen"
		CASE VAL(MyTens) = 15
			Result = "Fifteen"
		CASE VAL(MyTens) = 16
			Result = "Sixteen"
		CASE VAL(MyTens) = 17
			Result = "Seventeen"
		CASE VAL(MyTens) = 18
			Result = "Eighteen"
		CASE VAL(MyTens) = 19
			Result = "Nineteen"
		OTHERWISE
		ENDCASE
	ELSE
		* .. otherwise it's BETWEEN 20 AND 99.
		DO CASE
		CASE VAL(LEFT(MyTens, 1)) = 2
			Result = "Twenty "
		CASE VAL(LEFT(MyTens, 1)) = 3
			Result = "Thirty "
		CASE VAL(LEFT(MyTens, 1)) = 4
			Result = "Forty "
		CASE VAL(LEFT(MyTens, 1)) = 5
			Result = "Fifty "
		CASE VAL(LEFT(MyTens, 1)) = 6
			Result = "Sixty "
		CASE VAL(LEFT(MyTens, 1)) = 7
			Result = "Seventy "
		CASE VAL(LEFT(MyTens, 1)) = 8
			Result = "Eighty "
		CASE VAL(LEFT(MyTens, 1)) = 9
			Result = "Ninety "
		OTHERWISE
		ENDCASE

		* Convert ones place digit.
		Result = Result + ConvertDigit(RIGHT(MyTens, 1))
	ENDIF
	ConvertTens = Result
	RETURN ConvertTens
ENDFUNC

FUNCTION ConvertDigit
	LPARAMETERS MyDigit
	DO CASE
	CASE VAL(MyDigit) = 1
		ConvertDigit = "One"
	CASE VAL(MyDigit) = 2
		ConvertDigit = "Two"
	CASE VAL(MyDigit) = 3
		ConvertDigit = "Three"
	CASE VAL(MyDigit) = 4
		ConvertDigit = "Four"
	CASE VAL(MyDigit) = 5
		ConvertDigit = "Five"
	CASE VAL(MyDigit) = 6
		ConvertDigit = "Six"
	CASE VAL(MyDigit) = 7
		ConvertDigit = "Seven"
	CASE VAL(MyDigit) = 8
		ConvertDigit = "Eight"
	CASE VAL(MyDigit) = 9
		ConvertDigit = "Nine"
	OTHERWISE
		ConvertDigit = ""
	ENDCASE
	RETURN ConvertDigit
ENDFUNC

السلام عليكم ورحمة الله وبركاته

اولاً - كل عام وانت بخير ورمضان مبارك عليكم جميعا .

ثانياً - أود ان اشكر السيد الفاضل بالتكرم بالرد والمساعدة والحمد لله لقد قمت بوضع الكود وتم عمل التفقيط بطريقه صحيحة .

ولكم مني جزيل الشكر والتقدير ،،

احمد عامر

#9

الحمد لله انه زبط وكل عام وانتم بخير

:)

أستغفر الله العظيم و أتوب إليه

#10
mabrok1965 كتب:

اخى احمد

مرفق برنامج التفقيط وجدته فى المنتدى وهو يشتغل عندى تمام

إن شاء الله تستفيد منه

اخوك ابوعبدالرحمن من ليبيا

البرنامج لا يستطيع تفقيط هذا الرقم

9002001

او

2003004

او

3004007

ولكم فائق الشكر والاحترام

مواضيع مشابهة