تبليغاتX
برنامه نويسي VB
برنامه نويسي VB
يك تابع

بازم سلام.
از لطف همه دوستان ممنونم. راستي منظورتون از اينكه بيشتر كد بزارم چيه؟

امروز يه تابع جالب براتون مي‌ذارم. توسط اين تابع مي‌تونين اعداد را به صورتي حروفي تبديل كنين.
البته من اين تابع رو از وبلاگ http://try.persianblog.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

خدا حافظ.

2 نوشته شده در  چهارشنبه 2 شهریور1384ساعت 14:7  توسط موسي مرادي 


معرفي API

سلام

امروز با يه API آشنا شدم كه خيلي جالب بود، گفتم به شما هم ياد بدم.

 

توسط اين API كه اسمش ClipCursor هست، مي‌تونيد نشانگر ماوس رو در يك مستطيل زنداني كنيد.

معطل نكنيد. يه پروژه باز كنيد و كدهاي زير رو بهش اضافه كنيد.

 

Private Declare Function ClipCursor Lib "user32" (lpRect As Any) As Long

Private Type RECT

        Left As Long

        Top As Long

        Right As Long

        Bottom As Long

End Type

 

مي‌بينيد كه اين API فقط يه پارامتر داره و كار باهاش راحته.

حالا دو تا دكمه تو فرم بذاريد و كد زير رو تو رويداد click اولين دكمه بنويسيد:

 

  Dim rcRect As RECT

  rcRect.Left = Me.Left / 15

  rcRect.Top = Me.Top / 15

  rcRect.Right = Me.Width / 15 + rcRect.Left

  rcRect.Bottom = Me.Height / 15 + rcRect.Top

  ClipCursor rcRect

 

تو كليك دكمه دوم هم بنويسيد:

 

  Dim rcRect As RECT

  rcRect.Left = 0

  rcRect.Top = 0

  rcRect.Right = Screen.Width / 15

  rcRect.Bottom = Screen.Height / 15

  ClipCursor rcRect

 

حلا برنامه رو اجرا كنيد و دكمه اول رو كليك كنيد. حالا نشانگر ماوس رو تكون بديد.

جالب بود. نه؟ اگه رو دكمه دوم كليك كنيد، نشانگر آزاد مي‌شود. (البته آزاد نمي‌شود، فقط زندانش بزرگتر مي‌شود!)

 

توضيح: چهار متغير موجود در ساختار RECT، ابعاد مستطيل را مشخص مي‌كنند. مي‌تونيد به داخواه خود اونا رو تغيير بديد و امتحان كنيد. فقط به ياد داشته باشيد كه ابعاد داده شده بايد بر حسب پيكسل باشند، به همين خاطر بود كه من اونا رو به 15 تقسيم كردم، چون هر پيكسل 15 تويپ هست.

 

البته اگه يادتون رفت كه قبل از بستن پنجره، نشانگر رو آزاد كنيد، نگران نباشيد، دكمه ويندوز را از صفحه كليد بزنيد، آزاد مي‌شود.

 

ضمناً در مورد سؤال يكي از دوستان كه پرسيده بودند چطر مي‌تونيم با دكمه وسط ماوس، اسكرول‌بار رو كنترل كنيم، هر چي فكر كردم، راه حلي به ذهنم نرسيد. دوستان اگه مي‌دونن، لطف كنن.

2 نوشته شده در  سه شنبه 1 شهریور1384ساعت 15:35  توسط موسي مرادي