تبدیل عدد به حرف --

Private Const hezar = " هزار"
Private Const melun = " میلیون "
Private Const melyard = " میلیارد "
Private Const va = " و "

Public Function Adad(ByVal Adad_En 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_En As String
Dim LENAdad_En As Integer
hooroof = ""
STRAdad_En = Str(Val(Str(Adad_En)))
LENAdad_En = Len(STRAdad_En)

Select Case Adad_En
Case Is = 0
hooroof = "صفر"
Case 1 To 999
hooroof = Adad_En_Heji(Adad_En)

Case 1000 To 999999

If (Adad_En Mod 1000 = 0) Then hooroof = Adad_En_Heji(Int(Adad_En / 1000)) + hezar
If (Adad_En Mod 1000 <> 0) Then hooroof = Adad_En_Heji(Int(Adad_En / 1000)) + hezar + va + (Adad_En_Heji(Adad_En Mod 1000))

Case 1000000 To 999999999

SS = Val(Right$(STRAdad_En, 3))
hh = Val(Mid$(STRAdad_En, LENAdad_En - 5, 3))
mm = Val(Left$(STRAdad_En, LENAdad_En - 6))

If (SS = 0 And hh = 0) Then hooroof = Adad_En_Heji(mm) + melun
If (SS = 0 And hh <> 0) Then hooroof = Adad_En_Heji(mm) + melun + va + Adad_En_Heji(hh) + hezar
If (SS <> 0 And hh = 0) Then hooroof = Adad_En_Heji(mm) + melun + va + Adad_En_Heji(SS)
If (SS <> 0 And hh <> 0) Then hooroof = Adad_En_Heji(mm) + melun + va + Adad_En_Heji(hh) + hezar + va + Adad_En_Heji(SS)

Case 1000000000 To 999999999999.0#

SS = Val(Right$(STRAdad_En, 3))
hh = Val(Mid$(STRAdad_En, LENAdad_En - 5, 3))
mm = Val(Mid$(STRAdad_En, LENAdad_En - 8, 3))
yy = Val(Left$(STRAdad_En, LENAdad_En - 9))

If (SS = 0 And hh = 0 And mm = 0) Then hooroof = Adad_En_Heji(yy) + melyard
If (SS = 0 And hh = 0 And mm <> 0) Then hooroof = Adad_En_Heji(yy) + melyard + va + Adad_En_Heji(mm) + melun
If (SS = 0 And hh <> 0 And mm <> 0) Then hooroof = Adad_En_Heji(yy) + melyard + va + Adad_En_Heji(mm) + melun + va + Adad_En_Heji(hh) + hezar
If (SS <> 0 And hh <> 0 And mm <> 0) Then hooroof = Adad_En_Heji(yy) + melyard + va + Adad_En_Heji(mm) + melun + va + Adad_En_Heji(hh) + hezar + va + Adad_En_Heji(SS)

Case Is > 999999999999.0#
hooroof = "عدد وارد شده خارج از محدوده می باشد "

End Select

Adad = hooroof
End Function

Private Function Adad_En_Heji(ByVal Adad_En 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_En Mod 10
dahgan = Adad_En Mod 100
sadgan = Int(Adad_En / 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_En 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_En_Heji = behooroof
End Function

موفق باشید .

عشق یعنی ...

Zoom بر روی تصویر

' ----------------------------------------
' Required Imports :
'
' Microsoft.VisualBasic
' System
' System.Drawing
' System.Windows.Forms
' ----------------------------------------

' This code simulates a zoom effect with two
' bitmaps of the same size, where the second
' contains a zoomed center section of the first.
Dim bmp as Bitmap
Dim bmpZoom as Bitmap

' First call CreateBitmap, then call DefineZoom.
Sub CreateBitmap()
bmp = New Bitmap(75,75)
Dim g As Graphics = Graphics.FromImage(bmp)

Dim BlueBrush As New SolidBrush(Color.Blue)
Dim RedBrush As New SolidBrush(Color.Red)

Dim OuterRect As New Rectangle(0, 0, 200, 200)
g.FillRectangle(BlueBrush, OuterRect)

Dim InnerRect As New Rectangle(25, 25, 25, 25)
g.FillRectangle(RedBrush, InnerRect)

g.Dispose()
End Sub

Sub DefineZoom()
' Call this method after CreateBitmap
' from the constructor of your form.
bmpZoom = New Bitmap(bmp.Width, bmp.Height)
Dim g As Graphics = Graphics.FromImage(bmpZoom)

Dim srcRect As New Rectangle(CInt(bmp.Width / 4), CInt(bmp.Height / 4), _
CInt(bmp.Width / 2), CInt(bmp.Height / 2))
Dim dstRect As New Rectangle(0, 0, bmpZoom.Width, bmpZoom.Height)
g.DrawImage(bmp, dstRect, srcRect, GraphicsUnit.Pixel)
End Sub

Protected Overrides Sub OnPaint(ByVal e As PaintEventArgs)
e.Graphics.DrawImage(bmp, 0, 0)
e.Graphics.DrawImage(bmpZoom, 125, 0)

bmp.Dispose
bmpZoom.Dispose
MyBase.OnPaint(e)
End Sub