سورس کدهای مفید و کاربردی VB.Net

elahi

مدیریت
مدیر کل انجمن
تا حالا شده بخواهيد از API تو VB.Net استفاده كنيد.
كد زير يه نمونه براي اينكاره كه دايركتوري سيستم رو نشون ميده
کد:
Put this at the top of your module.


'Required in all cases when calling API functions


Imports System.Runtime.InteropServices

 
'Required in this example and any API function which


'use a string buffer.  Provides the StringBuilder class
 
Imports System.Text
 
'Put these declarations right under the class declaration 


'(e.g., in a Form, right under Public Class Form1)

 
  <DllImport("KERNEL32.DLL", EntryPoint:="GetSystemDirectoryW", _


       SetLastError:=True, CharSet:=CharSet.Unicode, _


       ExactSpelling:=True, _


       CallingConvention:=CallingConvention.StdCall)> _


    Public Shared Function GetSystemDirectory(ByVal Buffer _


         As StringBuilder, ByVal Size As Integer) As Long


        ' Leave function empty - DLLImport attribute 


        ' forces calls to GetSystemDirectory to


        ' be forwarded to GetSystemDirectory in KERNEL32.DLL


    End Function

 
    Public Const MAX_PATH As Integer = 256
 

 
'How to call the API function:
  

        Dim s As New StringBuilder(MAX_PATH)
         
        GetSystemDirectory(s, MAX_PATH)


        msgbox(s.ToString(), , "System Directory")
 

aidin2345

کاربر تازه وارد
تازه وارد
نمایش متن دلخواه در بالن ( کنار ساعت )
ابتدا یک NotifyIcon به فرم اضافه کرده و در properties ایکون متناسبی به آن انتخاب میکنیم
کد:
[LEFT]             NotifyIcon1.BalloonTipText = "به نرم افزار ------------- خوش آمدید"
[/LEFT]
کد:
[LEFT]             NotifyIcon1.BalloonTipTitle = "سلام"
            NotifyIcon1.ShowBalloonTip(10000)
[/LEFT]
 

aidin2345

کاربر تازه وارد
تازه وارد
بررسی درست بودن فرمت تاریخ فارسی

کد:
[LEFT]
    Public Function date_tester(ByVal a As String, ByVal msg As String) As Boolean
        Dim i As Integer
        Dim b As Boolean
        i = 0
        Try
            b = True
            i = Val(Microsoft.VisualBasic.Right(a, 2))
            If i > 31 Or i = 0 Then
                MsgBox("تاريخ " + msg + " " + "اشتباه وارد شده است", MsgBoxStyle.Information, "هشدار")
                b = False
                GoTo 100
            End If
            i = Val(Microsoft.VisualBasic.Mid(a, 6, 2))
            If i > 12 Or i = 0 Then
                MsgBox("تاريخ " + msg + " " + "اشتباه وارد شده است", MsgBoxStyle.Information, "هشدار")
                b = False
                GoTo 100
            End If
        Catch ex As Exception

        End Try
100:    Return b
    End Function
[/LEFT]
 

aidin2345

کاربر تازه وارد
تازه وارد
تبدیل عدد به حرف

ابتدا دو عدد TextBox و یک Button به فرم افزوده

سپس


کد:
[LEFT]
    Public Function GetFigures(ByVal x As String) As String

        Dim one(10) As String
        Dim two(10) As String
        Dim Three(10) As String
        Dim Hundred(10) As String
        Dim Thousand As String
        Dim lakh As String
        Dim miliyard As String
        Dim Million As String
        Dim Trillion As String
        Dim RetVal As String


        one(0) = "صفر" : one(1) = "يک" : one(2) = "دو" : one(3) = "سه" : one(4) = "چهار"
        one(5) = "پنج" : one(6) = "شش" : one(7) = "هفت" : one(8) = "هشت" : one(9) = "نه"

        two(0) = "ده" : two(1) = "يازده" : two(2) = "دوازده" : two(3) = "سيزده" : two(4) = "چهرده"
        two(5) = "پانزده" : two(6) = "شانزده" : two(7) = "هفده" : two(8) = "هيجده" : two(9) = "نوزده"

        Three(2) = "بيست" : Three(3) = "سي" : Three(4) = "چهل" : Three(5) = "پنجاه"
        Three(6) = "شصت" : Three(7) = "هفتاد" : Three(8) = "هشتاد" : Three(9) = "نود"

        Hundred(1) = "يکصد" : Hundred(2) = "دويست" : Hundred(3) = "سيصد"
        Hundred(4) = "چهارصد" : Hundred(5) = "پانصد" : Hundred(6) = "ششصد"
        Hundred(7) = "هفتصد" : Hundred(8) = "هشتصد" : Hundred(9) = "نهصد"

        Thousand = "هزار" : lakh = " هزار" : Million = "ميليون"
        miliyard = "میلیارد" : Trillion = "تريليون"

        Dim inp As String

        inp = CStr(Val(x))

        Select Case Len(inp)
            Case 1
                If x <> "" Then RetVal = one(CInt(x))
            Case 2
                If Int(CDbl(VB.Right(inp, 1))) > 0 And CDbl(VB.Left(inp, 1)) > 1 Then RetVal = " و " & GetFigures(CStr(Int(CDbl(VB.Right(inp, 1)))))
                If CDbl(VB.Left(inp, 1)) > 1 Then RetVal = Three(CInt(VB.Left(inp, 1))) & RetVal

                If CDbl(VB.Left(inp, 1)) = 1 Then RetVal = two(CInt(VB.Right(inp, 1)))

            Case 3
                If Int(CDbl(VB.Right(inp, 2))) > 0 Then RetVal = " و " & GetFigures(CStr(Int(CDbl(VB.Right(inp, 2)))))
                RetVal = Hundred(Int(CDbl(VB.Left(inp, 1)))) & RetVal
            Case 4
                If Int(CDbl(VB.Right(inp, 3))) > 0 Then RetVal = " و " & _
              GetFigures(CStr(Int(CDbl(VB.Right(inp, 3)))))
                RetVal = GetFigures(Int(CDbl(VB.Left(inp, 1)))) & Thousand & RetVal
            Case 5
                If Int(CDbl(VB.Right(inp, 3))) > 0 Then RetVal = " و " & GetFigures(CStr(Int(CDbl(VB.Right(inp, 3)))))
                RetVal = GetFigures(Int(CDbl(VB.Left(inp, 2)))) & Thousand & RetVal
            Case 6
                If CInt(VB.Right(inp, 5)) = 0 Then
                    RetVal = Hundred(Int(CDbl(VB.Left(inp, 1)))) & lakh
                Else
                    If CInt(VB.Right(inp, 3)) > 0 Then RetVal = " و " & GetFigures(CStr(CInt(VB.Right(inp, 3))))

                    RetVal = GetFigures(Int(CDbl(VB.Left(inp, 3)))) & lakh & RetVal
                End If
            Case 7
                If CInt(VB.Right(inp, 6)) > 0 Then RetVal = " و " & GetFigures(CStr(CInt(VB.Right(inp, 6))))
                RetVal = GetFigures(Int(CDbl(VB.Left(inp, 1)))) & Million & RetVal
            Case 8
                If CInt(VB.Right(inp, 6)) > 0 Then RetVal = " و " & GetFigures(CStr(CInt(VB.Right(inp, 6))))
                RetVal = GetFigures(Int(CDbl(VB.Left(inp, 2)))) & Million & RetVal
            Case 9
                If CInt(VB.Right(inp, 6)) > 0 Then RetVal = " و " & GetFigures(CStr(CInt(VB.Right(inp, 6))))
                RetVal = GetFigures(Int(CDbl(VB.Left(inp, 3)))) & Million & RetVal
            Case 10
                If CInt(VB.Right(inp, 9)) > 0 Then RetVal = " و " & GetFigures(CStr(CInt(VB.Right(inp, 9))))
                RetVal = GetFigures(Int(CDbl(VB.Left(inp, 1)))) & miliyard & RetVal
            Case 11
                If CInt(VB.Right(inp, 9)) > 0 Then RetVal = " و " & GetFigures(CStr(CInt(VB.Right(inp, 9))))
                RetVal = GetFigures(Int(CDbl(VB.Left(inp, 2)))) & miliyard & RetVal
            Case 12
                If Val(VB.Right(inp, 9)) > 0 Then RetVal = " و " & GetFigures(VB.Right(inp, 9))
                RetVal = GetFigures(Int(CDbl(VB.Left(inp, 3)))) & miliyard & RetVal
            Case 13
                If Val(VB.Right(inp, 12)) > 0 Then RetVal = " و " & GetFigures(VB.Right(inp, 12))
                RetVal = GetFigures(Int(CDbl(VB.Left(inp, 1)))) & Trillion & RetVal
            Case 14
                If Val(VB.Right(inp, 12)) > 0 Then RetVal = " و " & GetFigures(VB.Right(inp, 12))
                RetVal = GetFigures(Int(CDbl(VB.Left(inp, 2)))) & Trillion & RetVal
            Case 15
                If Val(VB.Right(inp, 12)) > 0 Then RetVal = " و " & GetFigures(VB.Right(inp, 12))
                RetVal = GetFigures(Int(CDbl(VB.Left(inp, 3)))) & Trillion & RetVal
        End Select
        GetFigures = " " & RetVal & " "
        GetFigures = Replace(GetFigures, "  ", " ")
    End Function
[/LEFT]

و کد زیر را برای دکمه اضافه میکنیم

کد:
[LEFT]
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        TextBox2.Text = GetFigures(TextBox1.Text)

    End Sub
[/LEFT]
 

aidin2345

کاربر تازه وارد
تازه وارد
تبدیل عدد به حرف

ابتدا دو عدد TextBox و یک Button به فرم افزوده

سپس

کد:
[LEFT]
    Public Function GetFigures(ByVal x As String) As String

        Dim one(10) As String
        Dim two(10) As String
        Dim Three(10) As String
        Dim Hundred(10) As String
        Dim Thousand As String
        Dim lakh As String
        Dim miliyard As String
        Dim Million As String
        Dim Trillion As String
        Dim RetVal As String


        one(0) = "صفر" : one(1) = "يک" : one(2) = "دو" : one(3) = "سه" : one(4) = "چهار"
        one(5) = "پنج" : one(6) = "شش" : one(7) = "هفت" : one(8) = "هشت" : one(9) = "نه"

        two(0) = "ده" : two(1) = "يازده" : two(2) = "دوازده" : two(3) = "سيزده" : two(4) = "چهرده"
        two(5) = "پانزده" : two(6) = "شانزده" : two(7) = "هفده" : two(8) = "هيجده" : two(9) = "نوزده"

        Three(2) = "بيست" : Three(3) = "سي" : Three(4) = "چهل" : Three(5) = "پنجاه"
        Three(6) = "شصت" : Three(7) = "هفتاد" : Three(8) = "هشتاد" : Three(9) = "نود"

        Hundred(1) = "يکصد" : Hundred(2) = "دويست" : Hundred(3) = "سيصد"
        Hundred(4) = "چهارصد" : Hundred(5) = "پانصد" : Hundred(6) = "ششصد"
        Hundred(7) = "هفتصد" : Hundred(8) = "هشتصد" : Hundred(9) = "نهصد"

        Thousand = "هزار" : lakh = " هزار" : Million = "ميليون"
        miliyard = "میلیارد" : Trillion = "تريليون"

        Dim inp As String

        inp = CStr(Val(x))

        Select Case Len(inp)
            Case 1
                If x <> "" Then RetVal = one(CInt(x))
            Case 2
                If Int(CDbl(VB.Right(inp, 1))) > 0 And CDbl(VB.Left(inp, 1)) > 1 Then RetVal = " و " & GetFigures(CStr(Int(CDbl(VB.Right(inp, 1)))))
                If CDbl(VB.Left(inp, 1)) > 1 Then RetVal = Three(CInt(VB.Left(inp, 1))) & RetVal

                If CDbl(VB.Left(inp, 1)) = 1 Then RetVal = two(CInt(VB.Right(inp, 1)))

            Case 3
                If Int(CDbl(VB.Right(inp, 2))) > 0 Then RetVal = " و " & GetFigures(CStr(Int(CDbl(VB.Right(inp, 2)))))
                RetVal = Hundred(Int(CDbl(VB.Left(inp, 1)))) & RetVal
            Case 4
                If Int(CDbl(VB.Right(inp, 3))) > 0 Then RetVal = " و " & _
              GetFigures(CStr(Int(CDbl(VB.Right(inp, 3)))))
                RetVal = GetFigures(Int(CDbl(VB.Left(inp, 1)))) & Thousand & RetVal
            Case 5
                If Int(CDbl(VB.Right(inp, 3))) > 0 Then RetVal = " و " & GetFigures(CStr(Int(CDbl(VB.Right(inp, 3)))))
                RetVal = GetFigures(Int(CDbl(VB.Left(inp, 2)))) & Thousand & RetVal
            Case 6
                If CInt(VB.Right(inp, 5)) = 0 Then
                    RetVal = Hundred(Int(CDbl(VB.Left(inp, 1)))) & lakh
                Else
                    If CInt(VB.Right(inp, 3)) > 0 Then RetVal = " و " & GetFigures(CStr(CInt(VB.Right(inp, 3))))

                    RetVal = GetFigures(Int(CDbl(VB.Left(inp, 3)))) & lakh & RetVal
                End If
            Case 7
                If CInt(VB.Right(inp, 6)) > 0 Then RetVal = " و " & GetFigures(CStr(CInt(VB.Right(inp, 6))))
                RetVal = GetFigures(Int(CDbl(VB.Left(inp, 1)))) & Million & RetVal
            Case 8
                If CInt(VB.Right(inp, 6)) > 0 Then RetVal = " و " & GetFigures(CStr(CInt(VB.Right(inp, 6))))
                RetVal = GetFigures(Int(CDbl(VB.Left(inp, 2)))) & Million & RetVal
            Case 9
                If CInt(VB.Right(inp, 6)) > 0 Then RetVal = " و " & GetFigures(CStr(CInt(VB.Right(inp, 6))))
                RetVal = GetFigures(Int(CDbl(VB.Left(inp, 3)))) & Million & RetVal
            Case 10
                If CInt(VB.Right(inp, 9)) > 0 Then RetVal = " و " & GetFigures(CStr(CInt(VB.Right(inp, 9))))
                RetVal = GetFigures(Int(CDbl(VB.Left(inp, 1)))) & miliyard & RetVal
            Case 11
                If CInt(VB.Right(inp, 9)) > 0 Then RetVal = " و " & GetFigures(CStr(CInt(VB.Right(inp, 9))))
                RetVal = GetFigures(Int(CDbl(VB.Left(inp, 2)))) & miliyard & RetVal
            Case 12
                If Val(VB.Right(inp, 9)) > 0 Then RetVal = " و " & GetFigures(VB.Right(inp, 9))
                RetVal = GetFigures(Int(CDbl(VB.Left(inp, 3)))) & miliyard & RetVal
            Case 13
                If Val(VB.Right(inp, 12)) > 0 Then RetVal = " و " & GetFigures(VB.Right(inp, 12))
                RetVal = GetFigures(Int(CDbl(VB.Left(inp, 1)))) & Trillion & RetVal
            Case 14
                If Val(VB.Right(inp, 12)) > 0 Then RetVal = " و " & GetFigures(VB.Right(inp, 12))
                RetVal = GetFigures(Int(CDbl(VB.Left(inp, 2)))) & Trillion & RetVal
            Case 15
                If Val(VB.Right(inp, 12)) > 0 Then RetVal = " و " & GetFigures(VB.Right(inp, 12))
                RetVal = GetFigures(Int(CDbl(VB.Left(inp, 3)))) & Trillion & RetVal
        End Select
        GetFigures = " " & RetVal & " "
        GetFigures = Replace(GetFigures, "  ", " ")
    End Function
[/LEFT]

و کد زیر را برای دکمه اضافه میکنیم

کد:
[LEFT]
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        TextBox2.Text = GetFigures(TextBox1.Text)

    End Sub
[/LEFT]
 

3aeeid

کاربر تازه وارد
تازه وارد
پاسخ : سورس کدهای مفید و کاربردی VB.Net

سلام یه کد میخوام که بشه توش متن های زیادی نوشت و بالا پایینش کرد مثلا یک سری داستان میخوام توش بزارم و برای خواندن کاربر بتونه بالا پایینش کنه.
 

elahi

مدیریت
مدیر کل انجمن
پاسخ : سورس کدهای مفید و کاربردی VB.Net

سلام یه کد میخوام که بشه توش متن های زیادی نوشت و بالا پایینش کرد مثلا یک سری داستان میخوام توش بزارم و برای خواندن کاربر بتونه بالا پایینش کنه.
دوست عزیز لطفا در تاپیک های آموزشی درخواست قرار ندید و سوال تون رو در بخش مربوطه با توضیحات کامل قرار بدید.
 

alialmasi

کاربر تازه وارد
تازه وارد
بهره گیری از پرسنل مجرب در امر جابه جایی وسائل و لوازم منزل، محل کار، محصولات تولیدی و… با بیشترین دقت و همچنین با به کارگیری از بهترین ابزارهای بسته بندی که شامل کارتن هایی با استحکام بالا ، بابل رپ (ضربه گیر حبابدار )، استرچ رپ (سلفون)،کیسه های مخصوص حمل لباس و رخت خواب و چسب های مخصوص با مناسب ترین قیمت آماده ی خدمت رسانی به شما عزیزان می باشد. باربری در غرب تهران
 
بالا