نمایش اعداد به صورت متن فارسی در کریستال ریپورت
هوالحکیم
سلام
جسارتاً میون این همه استاد من دوباره بعد از مدت ها برگشتم! شرمنده ام! تو را به خدا بهم نخندین ها!
من تازه یک کم سی شارپ یاد گرفتم. این کارفرمام به من گفت باید برنامه شما مثل برنامه داس ما در زیر سند به صورت فارسی مبلغ سند را بنویسه مثلاً "مبلغ به حروف: یک صد و بیست و چهار ریال". خلاصه اینکه من با بدبختی رفتم و یک تابع با گرامر VB در کریستال نوشتم.
این هم کدش:
طریقه ساختش هم به این صورت است که وقتی Crystal Report بازه(مثلاً یک گزارش باز کردیم)، در نوار ابزار اصلی ویژوال استودیو، دکمه Crystal Reports (یا Alt+R) را بزنید. بعد در زیر منوی Report (دکمه R را هم بزنید سریع تر بهش می رسید)، دکمه Formula WorkShop(یا F) را می زنیم. در پنجره باز شده، در پنل سمت چپ، روی Report Custom Function که شبیه یک چرخ دنده است، راست کلیک می کنیم و گزینه New را انتخاب می کنیم. حالا نام تابع را می نویسیم که اسم تابع من PersianNumber بود. بعد گزینه Use Editor را می زنیم. حالا از نوار ابزار دوم، اون آخر، جعبه انتخاب شدنی را که در آن Crystal Syntax انتخاب شده است را باز کرده و Basic Syntax را انتخاب می کنیم. آخه گرامر کریستال بیشتر شبیه پاسکال و دلفی بود و من ازش خوشم نمی اومد، با وجود اینکه این گرامر بیشتر شبیه C هست و من می میرم برای C ولی یک کم کار کردن با این گرامر سخت بود. خلاصه حالا در پنل بزرگه که وسط پنجره است و مربوط به کد نوشتن است، کد بالا را بنویسید و ذخیره کنید. حالا می تونید مثل یک تابع تو همه جا از این تابع استفاده کنید. مثلاً من یک فورمول ساختم و توش این تابع را برای یک عدد ثابت صدا زدم و گذاشتم تو صفحه. کار می ده. مشکلی هم نداره ولی تنها مشکلش حروف فارسیه! حتی فونت را هم عوض کردم و درست نشد. مثلاً به جای اینکه بنویسه : "هزار و دویست" می نویسه "ه ز ا ر و د و ی س ت"(البته بین حروف فضای خالی نیست، بلکه حروف جدا از هم نوشته می شن). نمی دونم عیب از تابع اتصال رشته کریستال ریپورته یا چیز دیگه؟ من خود برنامه کریستال ریپورت را ندارم و از همین IDE ویژوال استودیو استفاده می کنم. اگه شما اساتید کریستال ریپورت را دارید، ببینید اونجا مشکلی داره یا نه؟ راستی من هی می بینم شما نوشته اید که Right To Left متن را درست و کن و ... . این Propertie کجاست؟ من ویژوال استودیو 2005 دارم. وقتی روی یک متن کلیک می کنم، در خصوصیاتش چنین عنوانی نمی بینم! نکنه عیب از اینه؟ نکته بعدی که سوال داشتم اینه که من از کجا بفهمم کریستال ریپورتم نشخه چنده آخه ویژوال استودیو وقتی باز می شه می نویسه Crystal Report 2005! همین! هیچ جاش هم من چیزی نجستم که نسخه کریستال ریپورت را بگه؟ ممنون می شم این سوال را هم جواب بدهید.
Function PersianNumber (xNumber As Number) as String
' Global Variables
Dim GroupMax As Number
Dim Zero as String
Dim Units() as String, Teens() as String, Group() as String, Tens() as String, Hunds()
as String ' مقدار دهی اولیه متغییر های سراسری
GroupMax = 4
Zero = "صفر"
Units = Array("يك", "دو", "سه", "چهار", "پنج", "شش", "هفت", "هشت", "نه")
Teens = Array("يازده", "دوازده", "سيزده", "چهارده", "پانزده", "شانزده", "هفده", "هجده",
"نوزده") Tens = Array("ده", "بيست", "سي", "چهل", "پنجاه", "شصت", "هفتاد", "هشتاد", "نود")
Hunds = Array("يكصد", "دويست", "سيصد", "چهارصد", "پانصد", "ششصد", "هفتصد", "هشتصد", "نهصد")
Group = Array("", "هزار", "ميليون", "ميليارد", "بيليون")
' Local Variables
Dim sRet as String, Temp as String
Dim bNegative as Boolean
Dim i As Number, R As Number, RMod100 As Number
' Hundreds, Tens, Units
Dim H As Number, T As Number, U As Number
' مقدار دهی اولیه متغییر های محلی
bNegative = false
' شروع تابع
If xNumber = 0 Then
PersianNumber = Zero ' ****** return
exit function
ElseIf xNumber < 0 Then
bNegative = true
xNumber = -xNumber
End If
i = 1
sRet = ""
while i = 1
Temp = ""
R = xNumber MOD 1000
H = Fix(R / 100)
RMod100 = R MOD 100
T = Fix(RMod100 / 10)
U = RMod100 MOD 10
xNumber = Fix(xNumber / 1000)
if H >= 1 Then
Temp = Temp + Hunds(H) + " و "
End If
If RMod100 >= 11 AND RMod100 = 1 Then
Temp = Temp + Tens(T) + " و "
End If
If U >= 1 Then
Temp = Temp + Units(U) + " و "
End If
End If
If Len(Temp) > 3 Then
Temp = Left (Temp, Length(Temp) - 3) 'Deleting Extra " و "
End If
If R 0 Then
If sRet = "" Then
sRet = Temp + Group(i)
Else
sRet = Temp + Group(i) + " و " + sRet
End If
End If
i = i + 1
Wend
If bNegative Then
sRet = "منفي " + sRet
End If
If sRet = "" Then
sRet = "امکان تبدیل عدد وجود ندارد"
End If
PersianNumber = sRet
End Function
منتظر جواب های شما هستم
یا علی
حق نگهدارتون
پاسخ با نقل قول
