تالار گفتگوي استقلال
به مجموعه تالار های هواداران باشگاه استقلال خوش آمديد . برای استفاده بيشتر از تالارها لطفا عضو شويد



 
الرئيسيةPortalمكتبة الصورپرسشهاي متداولجستجوثبت نامورود

شاطر | 
 

 آموزش برنامه نويسي (ويژال بيسيک 6)

مشاهده موضوع قبلي مشاهده موضوع بعدي اذهب الى الأسفل 
نويسندهپيام
Iman
كاربر فعال
كاربر فعال


تعداد پستها : 645
Age : 26
Registration date : 2008-03-09

پستعنوان: آموزش برنامه نويسي (ويژال بيسيک 6)   السبت مارس 14, 2009 10:52 am

آموزش نرم افزار ویژال بیسیک 6
بازگشت به بالاي صفحه اذهب الى الأسفل
خواندن مشخصات فردي http://www.computer2000.mihanbb.com
Iman
كاربر فعال
كاربر فعال


تعداد پستها : 645
Age : 26
Registration date : 2008-03-09

پستعنوان: تابعی برای تبدیل عدد به معادل حرفی (فارسی)   السبت مارس 14, 2009 10:56 am

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

نحوه استفاده از تابع :

تابع Adad که در زیر ارائه شده است یک عدد را بعنوان ورودی گرفته و معادل حروفی آن عدد در زبان فارسی را بعنوان خروجی تولید می کند. مثلا (Adad(1373 مقدار"یکهزار و سیصد و هفتاد و سه" را بعنوان خروجی تولید می کند.برای استفاده از این توابع باید از چند خط پایین تر (Start of Module) تا انتهای این یادداشت را در حافظه کپی (Copy) کرده و در یک ماجول جدید در اکسس یا VB ، Paste کنید . ( توجه داشته باشید که نمایش کدهای نوشته شده در اینجا راست به چپ است که پس از کپی کردن آن در ماجول اکسس بشکل صحیح نمایش داده خواهد شد)

' *********** Start of Module ***********

'توابع تبدیل عدد به معادل حروفی آن در زبان فارسی

'برنامه نویس : ایمان ادریسی

' پست الکترونیک : arash66_2009@yahoo.com

Function Adad(ByVal Number As Double) As String

If Number = 0 Then

Adad = "صفر"

End If

Dim Flag As Boolean

Dim S As String

Dim I, L As Byte

Dim K(1 To 5) As Double

S = Trim(Str(Number))

L = Len(S)

If L > 15 Then

Adad = "بسیار بزرگ"

Exit Function

End If

For I = 1 To 15 - L

S = "0" & S

Next I

For I = 1 To Int((L / 3) + 0.99)

K(5 - I + 1) = Val(Mid(S, 3 * (5 - I) + 1, 3))

Next I

Flag = False

S = ""

For I = 1 To 5

If K(I) <> 0 Then

Select Case I

Case 1

S = S & Three(K(I)) & " تریلیون"

Flag = True

Case 2

S = S & IIf(Flag = True, " و ", "") & Three(K(I)) & " میلیارد"

Flag = True

Case 3

S = S & IIf(Flag = True, " و ", "") & Three(K(I)) & " میلیون"

Flag = True

Case 4

S = S & IIf(Flag = True, " و ", "") & Three(K(I)) & " هزار"

Flag = True

Case 5

S = S & IIf(Flag = True, " و ", "") & Three(K(I))

End Select

End If

Next I

Adad = S

End Function

Function Three(ByVal Number As Integer) As String

Dim S As String

Dim I, L As Long

Dim h(1 To 3) As Byte

Dim Flag As Boolean

L = Len(Trim(Str(Number)))

If Number = 0 Then

Three = ""

Exit Function

End If

If Number = 100 Then

Three = "یکصد"

Exit Function

End If

If L = 2 Then h(1) = 0

If L = 1 Then

h(1) = 0

h(2) = 0

End If

For I = 1 To L

h(3 - I + 1) = Mid(Trim(Str(Number)), L - I + 1, 1)

Next I

Select Case h(1)

Case 1

S = "یکصد"

Case 2

S = "دویست"

Case 3

S = "سیصد"

Case 4

S = "چهارصد"

Case 5

S = "پانصد"

Case 6

S = "ششصد"

Case 7

S = "هفتصد"

Case 8

S = "هشتصد"

Case 9

S = "نهصد"

End Select

Select Case h(2)

Case 1

Select Case h(3)

Case 0

S = S & " و " & "ده"

Case 1

S = S & " و " & "یازده"

Case 2

S = S & " و " & "دوازده"

Case 3

S = S & " و " & "سیزده"

Case 4

S = S & " و " & "چهارده"

Case 5

S = S & " و " & "پانزده"

Case 6

S = S & " و " & "شانزده"

Case 7

S = S & " و " & "هفده"

Case 8

S = S & " و " & "هجده"

Case 9

S = S & " و " & "نوزده"

End Select

Case 2

S = S & " و " & "بیست"

Case 3

S = S & " و " & "سی"

Case 4

S = S & " و " & "چهل"

Case 5

S = S & " و " & "پنجاه"

Case 6

S = S & " و " & "شصت"

Case 7

S = S & " و " & "هفتاد"

Case 8

S = S & " و " & "هشتاد"

Case 9

S = S & " و " & "نود"

End Select

If h(2) <> 1 Then

Select Case h(3)

Case 1

S = S & " و " & "یک"

Case 2

S = S & " و " & "دو"

Case 3

S = S & " و " & "سه"

Case 4

S = S & " و " & "چهار"

Case 5

S = S & " و " & "پنج"

Case 6

S = S & " و " & "شش"

Case 7

S = S & " و " & "هفت"

Case 8

S = S & " و " & "هشت"

Case 9

S = S & " و " & "نه"

End Select

End If

S = IIf(L < 3, Right(S, Len(S) - 3), S)

Three = S

End Function

' *********** End Of Module ***********
بازگشت به بالاي صفحه اذهب الى الأسفل
خواندن مشخصات فردي http://www.computer2000.mihanbb.com
 
آموزش برنامه نويسي (ويژال بيسيک 6)
مشاهده موضوع قبلي مشاهده موضوع بعدي بازگشت به بالاي صفحه 
صفحه 1 از 1

صلاحيات هذا المنتدى:شما نمي توانيد در اين بخش به موضوعها پاسخ دهيد
تالار گفتگوي استقلال :: ورود به بخش مركزي تالار :: COMPUTER-
پرش به: