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



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

شاطر
 

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

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

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

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

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

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

آموزش برنامه نويسي (ويژال بيسيک 6) Empty
پستعنوان: تابعی برای تبدیل عدد به معادل حرفی (فارسی)   آموزش برنامه نويسي (ويژال بيسيک 6) Emptyالسبت مارس 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-
پرش به: