خوب من هم يه تحقيق كردم كه مشكل رو ريشه كن كنيم (از بيخ)
مطالب زير اكثرا از سايت
WWW.barnamenevis.org گرفته شده و اكثرا نوشته آقاي مسعود غيبي است
1-براي استفاده از امكان Right to Left در برنامه ها فايل VBAME.DLL موجود در پوشه سيستم را به همراه برنامه خود قرار دهيد.
2
-برای تبديل صفحه کليد به فارسی در ويژوال بيسيک 6 :
ابتدا تابع زير را تعريف کنيد :
Public Declare Function LoadKeyboardLayout Lib "user32" Alias "LoadKeyboardLayoutA" (ByVal pwszKLID As String, ByVal flags As Long) As Long
ويندوز اکس پی و 2000 که فارسی نصب شده باشد :
Dim xx As Long
xx = LoadKeyboardLayout("00000429", 1)
ويندوز پارسا 99 و امثال آن :
Dim xx As Long
xx = LoadKeyboardLayout("00000401", 1)
کد 401 برای عربی عربستان است که در ويندوز پارسا 99 به جای فارسی به کار می رود.
(برگرفته از سايت حامد بنايي)(ha_60 اينم كه از يه جا ديگه گرفته)
كد زير براي تبديل مقدار عددي به حروف است.
به اين نكته دقت داشته باشيد كه حداكثر مقدار قابل قبول براي اين تابع 999,999,999,999 (نهصد و نود و نه ميليارد و نهصد و نود و نه ميليون و نهصد و نود نه هزار و نهصد و نود و نه) مي باشد.
تابع زير نوشته جناب آقاي بابك بخشايش هست.
کد:
Option Explicit
Private Const hezar = " هزار"
Private Const melun = " ميليون"
Private Const melyard = " ميليارد"
Private Const va = " و "
Public Function heji_adad(ByVal adad As Double) As String
Dim hooroof As String
Dim SS As Integer 'sadgan
Dim hh As Integer 'hezargan
Dim mm As Integer 'melungan
Dim yy As Integer 'melyardgan
Dim STRadad As String
Dim LENadad As Integer
STRadad = Str(Val(Str(adad)))
LENadad = Len(STRadad)
Select Case adad
Case Is = 0
hooroof = "صفر"
Case 1 To 999
hooroof = Adad_Heji(adad)
Case 1000 To 999999
If (adad Mod 1000 = 0) Then hooroof = Adad_Heji(Int(adad / 1000)) + hezar
If (adad Mod 1000 <> 0) Then hooroof = Adad_Heji(Int(adad / 1000)) + hezar + va + (Adad_Heji(adad Mod 1000))
Case 1000000 To 999999999
SS = Val(Right$(STRadad, 3))
hh = Val(Mid$(STRadad, LENadad - 5, 3))
mm = Val(Left$(STRadad, LENadad - 6))
If (SS = 0 And hh = 0) Then hooroof = Adad_Heji(mm) + melun
If (SS = 0 And hh <> 0) Then hooroof = Adad_Heji(mm) + melun + va + Adad_Heji(hh) + hezar
If (SS <> 0 And hh = 0) Then hooroof = Adad_Heji(mm) + melun + va + Adad_Heji(SS)
If (SS <> 0 And hh <> 0) Then hooroof = Adad_Heji(mm) + melun + va + Adad_Heji(hh) + hezar + va + Adad_Heji(SS)
Case 1000000000 To 999999999999#
SS = Val(Right$(STRadad, 3))
hh = Val(Mid$(STRadad, LENadad - 5, 3))
mm = Val(Mid$(STRadad, LENadad - 8, 3))
yy = Val(Left$(STRadad, LENadad - 9))
If (SS = 0 And hh = 0 And mm = 0) Then hooroof = Adad_Heji(yy) + melyard
If (SS = 0 And hh = 0 And mm <> 0) Then hooroof = Adad_Heji(yy) + melyard + va + Adad_Heji(mm) + melun
If (SS = 0 And hh <> 0 And mm <> 0) Then hooroof = Adad_Heji(yy) + melyard + va + Adad_Heji(mm) + melun + va + Adad_Heji(hh) + hezar
If (SS <> 0 And hh <> 0 And mm <> 0) Then hooroof = Adad_Heji(yy) + melyard + va + Adad_Heji(mm) + melun + va + Adad_Heji(hh) + hezar + va + Adad_Heji(SS)
Case Is > 999999999999#
hooroof = "عدد وارد شده بزرگتر از 999999999999 است"
End Select
heji_adad = hooroof
End Function
Private Function Adad_Heji(ByVal adad As Integer) As String
Dim yekan As Byte
Dim dahgan As Byte
Dim sadgan As Byte
Dim behooroof As String
Dim heji(19) As String
Dim heji_dahgan(9) As String
Dim heji_sadgan(9) As String
'-------------------------------
heji(1) = "يک": heji(2) = "دو": heji(3) = "سه": heji(4) = "چهار": heji(5) = "پنج"
heji(6) = "شش": heji(7) = "هفت": heji(8) = "هشت": heji(9) = "نه": heji(10) = "ده"
heji(11) = "يازده": heji(12) = "دوازده": heji(13) = "سيزده": heji(14) = "چهارده": heji(15) = "پانزده"
heji(16) = "شانزده": heji(17) = "هفده": heji(18) = "هيجده": heji(19) = "نوزده"
'-------------------------------
heji_dahgan(1) = "ده"
heji_dahgan(2) = "بيست"
heji_dahgan(3) = "سي": heji_dahgan(4) = "چهل": heji_dahgan(5) = "پنجاه"
heji_dahgan(6) = "شصت": heji_dahgan(7) = "هفتاد": heji_dahgan(8) = "هشتاد"
heji_dahgan(9) = "نود"
'-------------------------------
heji_sadgan(1) = "يكصد": heji_sadgan(2) = "دويست": heji_sadgan(3) = "سيصد"
heji_sadgan(4) = "چهارصد": heji_sadgan(5) = "پانصد": heji_sadgan(6) = "ششصد"
heji_sadgan(7) = "هفتصد": heji_sadgan(8) = "هشتصد": heji_sadgan(9) = "نهصد"
'-------------------------------
yekan = adad Mod 10
dahgan = adad Mod 100
sadgan = Int(adad / 100)
'-------------------------------
If dahgan < 20 Then
If (sadgan = 0) Then behooroof = heji(dahgan)
If (sadgan <> 0) Then behooroof = heji_sadgan(sadgan) + va + heji(dahgan)
If (yekan = 0 And dahgan = 0) Then behooroof = heji_sadgan(sadgan)
Else
dahgan = (adad Mod 100) - yekan
If (sadgan = 0 And yekan = 0) Then behooroof = heji_dahgan(dahgan / 10)
If (sadgan = 0 And yekan <> 0) Then behooroof = heji_dahgan(dahgan / 10) + va + heji(yekan)
If (sadgan <> 0 And yekan = 0) Then behooroof = heji_sadgan(sadgan) + va + heji_dahgan(dahgan / 10)
If (sadgan <> 0 And yekan <> 0) Then behooroof = heji_sadgan(sadgan) + va + heji_dahgan(dahgan / 10) + va + heji(yekan)
End If
Adad_Heji = behooroof
End Function
طرز استفاده :
کد:
Text1.text = heji_adad(156489)
با اجراي کد بالا عبارت "يكصد و پنجاه و شش هزار و چهارصد و هشتاد و نه" در Text1 نمايش داده خواهد شد.
صالا خودتون برين بخونين به من چه
http://www.barnamenevis.org/forum/viewtopic.php?t=19021
صفحه اصلی
انجمن
جستجو
فهرست اعضا
افزونه های فایرفاکس
» 
تشکر شده توسط :
