نمونه کد های کوچک و کاربردی VB.Net

این سورس نشان می دهد سیستم عامل از چه مسیری راه اندازی شده است.

برای استفاده از این کد باید مرجع System.Management را به پروژه خود اضافه کنید و سپس این خط را در خارج از Public Class فایل وی بی قرار دهید:

کد:

---

Imports System.Management

---

حال این کد مسیر را با جعبه متنی نمایش می دهد:

کد:

---

Dim BootDevice As String
Dim searcher As New ManagementObjectSearcher("select * from Win32_BootConfiguration")
For Each share As ManagementObject In searcher.Get
    BootDevice = share("Description").ToString()
Next
MsgBox(BootDevice)

---

منبع: dotNetSpider

اين تابع يك رشته ي ورودي را به عنوان آرگومان دريافت مي كند. سپس حروف رشته را از آخر به اول به ترتيب در يك متغير قرار مي دهد. در نهايت تابع مقدار مقلوب شده را بر مي گرداند.

کد:

---

Function Reserver(ByVal UrText As String) As String
      For i As Integer = UrText.Length - 1 To 0 Step -1
            Reserver += UrText.Chars(i)
        Next
End Function

---

مثال:

کد:

---

MsgBox(Reserver("PC Network"))

---

استاندارد اسكي براي حروف، از 0 تا 255 شماره گذاري مي شود. براي دريافت كد اسكي يك كاركتر از دستور زير استفاده مي كنيم:

کد:

---

Asc(Your Character As String)

---

مانند:

Asc("A")

براي تبديل كد اسكي به حرف معادل آن از اين فرمان كمك مي گيريم:

کد:

---

Chr(Your Code As Integer)

---

مانند:

Chr(65)

در ويژوال استاديو 2008 يه سري كد هاي پايه براي آشنايي با زبان هاي دات نت قرار داده شده. براي كساني كه دوست دارن سريع خودشون را با زبان .Net تطبيق بدن اين الگو ها خيلي مفيده.

براي دست يابي به اين الگو هاي آماده؛ ابتدا ويژوال استاديو رو باز كنيد. در نوار منو به قسمت Help برويد و روي گزينه ي Samples كليك كنيد.
حالا يه زبانه ي جديد باز ميشه. در اين برگه روي لينك local Samples folder كليك كنيد تا وارد پوشه ي الگو بشيد.
در اين پوشه بسته به تنظيمات نصب مي تونيد سورس هاي آماده ويژوال بيسيك، سي شارپ و سي پلاس پلاس رو مشاهده كنيد. در نهايت با Extract كردن بسته ي مورد نظر خودتون، مي تونيد به پروژه ها دسترسي داشته باشيد و از اون ها استفاده كنيد.:party:

با سلام!

براي اين كار ابتدا مجموعه Globalization را به برنامه اضافه مي كنيم:

کد:

---

Imports System.Globalization

---

سپس روي فرم برنامه جعبه متني مورد نظر خود را با نام TextBox1 اضافه مي كنيم.

حال در رويداد TextBox1_GotFocus كد زير را قرار مي دهيم:

کد:

---

Application.CurrentInputLanguage = InputLanguage.FromCulture(New CultureInfo("fa"))

---

با اين كار زبان جعبه فارسي مي شود.

براي برگرداندن زبان به حالت پيش فرض بايد در رويداد TextBox1_LostFocus كد زير را قرار دهيم:

کد:

---

Application.CurrentInputLanguage = InputLanguage.DefaultInputLanguage

---

برای مشاهده این لینک/عکس می بایست عضو شوید !برای عضویت اینجا کلیک کنید ]

تشکر خیلی زیاد

فرض كنيد كه ما مي خواهيم در بازه هاي زماني متفاوت متني را وارد جعبه ي متني كنيم و توجه كاربر را به آن متن جديد معطوف كنيم. اگر طول متن ها از اندازه ي TextBox فرضا" TextBox1 بيش تر باشد، متن ها جديد كه به جعبه اضافه مي شوند ديگر نمايش داده نخواهند شد و كاربر مي بايستي براي مشاهده ي اين متن هاي جديد، Scrollbar مربوط به TextBox1 را به سمت پايين بكشد تا بتواند ادامه ي متن و در واقع متن هاي جديد را مشاهده كنيد. با اجراي كد زير عمل Scroll كردن را به طور خودكار صورت مي گيرد:

کد:

---

TextBox1.SelectionStart = TextBox1.TextLength
TextBox1.ScrollToCaret()
TextBox1.Refresh()

---

نمونه از اين كاربرد در برنامه اي مثل Hyper Terminal يا پنجره ي گفتمان پيام رسان ها مشاهده مي شود كه همواره بخش انتهايي جعبه ي حاوي متن نمايش داده مي شود و در واقع Scrollbar هميشه در پايين نگه داشته مي شود.

اين تابع با دريافت يك تصوير از نوع Bitmap، مقدار Grayscale شده ي آن تصوير را بر مي گرداند. اساس كار تابع ذيل، تصوير بردار هاي رنگ به روي بردار (1, 1, 1) است. البته روش هاي سريع تري نظير ماتريس تبديل و يا توابع ويرايش قالب پيكسل (در Framework 4.0) براي اين كار وجود دارد.

کد:

---

Function ToGrayscale(ByVal inpImg As Bitmap) As Bitmap
        Dim bytrgb As Byte
        For i As Integer = 0 To inpImg.Width - 1
            For j As Integer = 0 To inpImg.Height - 1
                bytrgb = Convert.ToByte((Val(inpImg.GetPixel(i, j).R) + Val(inpImg.GetPixel(i, j).G) + Val(inpImg.GetPixel(i, j).B)) / 3)
                inpImg.SetPixel(i, j, Color.FromArgb(bytrgb, bytrgb, bytrgb))
            Next
        Next
        Return inpImg
End Function

---

تابع زير با دريافت يك تصوير Bitmap به عنوان آرگومان، با اعمال يك نگاشت ساده روي رنگ تك تك پيكسل ها تصوير ورودي، مقدار Negative شده ي عكس را بر مي گرداند:

کد:

---

Function ToNegative(ByVal inpImg As Bitmap) As Bitmap
      For i As Integer = 0 To inpImg.Width - 1
          For j As Integer = 0 To inpImg.Height - 1
                inpImg.SetPixel(i, j, Color.FromArgb(255 - Val(inpImg.GetPixel(i, j).R), 255 - Val(inpImg.GetPixel(i, j).G), 255 - Val(inpImg.GetPixel(i, j).B)))
          Next
        Next
        Return inpImg
End Function

---

اين كد مقدار Boolean مربوط به روشن/خاموش بودن كليد CapsLock را بر مي گرداند:

کد:

---

Control.IsKeyLocked(Keys.CapsLock)

---

اگر سورس زير را در رويداد Tick يك Timer قرار دهيد، به هنگام شروع به كار تايمر، فرم با جلوه اي زيبا به شكل يكنواخت از گوشه ها كوچك شده و در نهايت بسته مي شود:

کد:

---

Size = New Size(Width - 2, Height - 2)
Location = New Point(Location.X + 1, Location.Y + 1)
If Size.Height < 120 Then End

---

كد زير در رشته ي mystr، تمامي عبارات قديمي مورد نظر شما (old) را با عبارات جديدي كه شما تعيين مي كنيد (new) جايگزين مي كند:

کد:

---

Dim mystr As String = "Old Technology, Old Life"
While mystr.Contains("Old")
  mystr = mystr.Replace("Old", "New")
End While

---

با اجرای کد زیر در هر تابع یا رویدادی می توانید شکل نشانگر موشواره روی فرم را به شکل ساعت شنی تبدیل کنید:

کد:

---

Cursor = Cursors.WaitCursor

---

با کد ساده ی زیر بدون استفاده از هیچ کتابخونه یا الگوریتمی می توانید تاریخ جاری میلادی را به تاریخ خورشیدی تبدیل کنید:

کد:

---

Dim persian As New System.Globalization.PersianCalendar()
MsgBox(persian.GetYear(Now.Date).ToString() + "/" + persian.GetMonth(Now.Date).ToString() + "/" + persian.GetDayOfMonth(Now.Date).ToString())

---

کد زیر مربوط به الگوریتم تشخیص خطای CRC-16 است:

کد:

---

    Private Function CRC16(ByVal modbus() As Byte) As Int32
        Dim crc As Int32 = 0
        For i As Integer = 0 To modbus.Length - 1
            crc = crc Xor modbus(i)
            For j As Byte = 1 To 8
                If crc And &H1 Then
                    crc = (crc >> 1) Xor &H8408
                Else
                    crc = crc >> 1
                End If
            Next
        Next
        Return crc
    End Function

---

کد زیر رشته ای را تحت شبکه به یک IP خاص با شماره پورت TCP مشخص ارسال می کند:

کد:

---

Dim clientSocket As New System.Net.Sockets.TcpClient()
clientSocket.Connect("127.0.0.1", 1001) 'IP:Port
Dim serverStream As System.Net.Sockets.NetworkStream = clientSocket.GetStream()
Dim data() As Byte = System.Text.Encoding.ASCII.GetBytes("Hello World") 'Message
serverStream.Write(data, 0, data.Length)

---

گاهی اوقات میشه مثال های ساده و در عین حال جالبی رو تو برای مشاهده این لینک/عکس می بایست عضو شوید !برای عضویت اینجا کلیک کنید ] پیدا کرد؛ مثل این ماژول زیر که زمان و تاریخ سیستم رو در فرمت های متنوعی نمایش میده:

کد:

---

Module Module1
    Sub Main()
    ' Acquire current time and then try format strings.
    Dim now As DateTime = DateTime.Now
    Console.WriteLine(now.ToString("d"))
    Console.WriteLine(now.ToString("D"))
    Console.WriteLine(now.ToString("f"))
    Console.WriteLine(now.ToString("F"))
    Console.WriteLine(now.ToString("g"))
    Console.WriteLine(now.ToString("G"))
    Console.WriteLine(now.ToString("m"))
    Console.WriteLine(now.ToString("M"))
    Console.WriteLine(now.ToString("o"))
    Console.WriteLine(now.ToString("O"))
    Console.WriteLine(now.ToString("s"))
    Console.WriteLine(now.ToString("t"))
    Console.WriteLine(now.ToString("T"))
    Console.WriteLine(now.ToString("u"))
    Console.WriteLine(now.ToString("U"))
    Console.WriteLine(now.ToString("y"))
    Console.WriteLine(now.ToString("Y"))
    End Sub
End Module

---

خروجی برنامه

5/18/2010
Tuesday, May 18, 2010
Tuesday, May 18, 2010 4:47 PM
Tuesday, May 18, 2010 4:47:55 PM
5/18/2010 4:47 PM
5/18/2010 4:47:55 PM
May 18
May 18
2010-05-18T16:47:55.9620000-06:00
2010-05-18T16:47:55.9620000-06:00
2010-05-18T16:47:55
4:47 PM
4:47:55 PM
2010-05-18 16:47:55Z
Tuesday, May 18, 2010 10:47:55 PM
May, 2010
May, 2010

تابع زیر عبارتی را درون یک رشته جست و جو می کند و آرایه ای از اندیس مکان های این عبارت را درون آن رشته بر می گرداند:

کد:

---

    Function IndexOfArray(ByVal inputStr As String, ByVal searchStr As String) As Integer()
        Dim strCount As Integer = 0
        Dim currInx As Integer = inputStr.IndexOf(searchStr)
        Dim inxArr(0) As Integer

        While currInx > -1
            ReDim Preserve inxArr(strCount)
            inxArr(strCount) = currInx
            strCount += 1
            currInx = inputStr.IndexOf(searchStr, currInx + 1)
        End While

        If strCount = 0 Then inxArr(0) = -1
        Return inxArr
    End Function

---

دستور String.Join برای چسباندن آرایه ای از رشته ها با یک جدا کننده (Separator) به کار می رود و به گونه ای عکس عمل Split است که یک رشته را با توجه به یک جدا کننده به آرایه ای از رشته ها تبدیل می کند.

مثال:

کد:

---

Dim alphabet() As String = {"A", "B", "C"}
String.Join(",", alphabet)

---

خروجی:

کد:

---

A,B,C

---

حتما" با دستور CInt آشنا هستید که یک شی مانند String را تبدیل به یک Integer می کند. ولی اگر بخواهیم آرایه ای از رشته ها را تبدیل به Integer کنیم چطور؟ کافیست نگاهی به مثال زیر بیاندازیم:

کد:

---

Dim numStr() As String = {"1", "10", "100"}
Dim numInt = numStr.ToList.ConvertAll(AddressOf Int32.Parse)

---

تابع زیر با دریافت مسیر جست و جو و نام فایل، به دنبال آن فایل در مسیر تعیین شده می گردد و در صورتی که فایل مورد نظر را یافت، مسیر آن را بر می گرداند:

کد:

---

Function searcher(ByVal path As String, ByVal fileName As String) As String
    Try
        For Each folderName As String In My.Computer.FileSystem.GetDirectories(path)
            If My.Computer.FileSystem.FileExists(folderName + "\" + fileName) Then Return folderName
            searcher(folderName, fileName)
        Next
    Catch
    End Try
    Return "File Not Found."
End Function

---

کد زیر با دریافت تصویر راست و چپ تصویر سه بعدی را به صورت Anaglyph ایجاد می کند:

کد:

---

    Function CreateAnaglyph(ByVal left As Bitmap, ByVal right As Bitmap) As Bitmap
        If left.Width <> right.Width Or left.Height <> right.Height Then Return Nothing
        Dim final As New Bitmap(left.Width, left.Height)
        For i As Integer = 0 To left.Width - 1
            For j As Integer = 0 To left.Height - 1
                final.SetPixel(i, j, Drawing.Color.FromArgb(left.GetPixel(i, j).R, right.GetPixel(i, j).G, right.GetPixel(i, j).B))
            Next
        Next
        Return final
    End Function

---

اگر تمایل دارید که در یک جعبه ی متنی فقط کارکتر عددی وارد شود، کافیست کد زیر را در رویداد KeyPress آن جعبه ی متنی وارد کنید:

کد:

---

e.Handled = Not Char.IsDigit(e.KeyChar)

---

کد زیر با گرفتن تصاویر سمت راست و چپ تصویر پولاریزه شده ی سه بعدی رو تولید می کنه:

کد:

---

    Function Polarizor(ByVal left As Bitmap, ByVal right As Bitmap) As Bitmap
        If left.Width <> right.Width And left.Height <> right.Height Then Return Nothing
        Dim final As New Bitmap(left.Width, left.Height)
        For j As Integer = 1 To left.Height / 2 - 1
            For i As Integer = 0 To left.Width - 1
                final.SetPixel(i, 2 * j, left.GetPixel(i, 2 * j))
                final.SetPixel(i, 2 * j + 1, right.GetPixel(i, 2 * j + 1))
            Next
        Next
        Return final
    End Function

---

برای تشخیص معتبر بودن یا نبودن تاریخ شمسی می توانید از کد زیر استفاده کنید:

کد:

---

        Try
            Const pd As String = "1393/3/30"
            Dim spd As String() = Split(pd, "/")
            Dim yy As Integer = Val(spd(0))
            Dim mm As Integer = Val(spd(1))
            Dim dd As Integer = Val(spd(2))
            Dim fpd As String = String.Format("{0:0000}/{1:00}/{2:00}", yy, mm, dd)

            Dim pc As New PersianCalendar()
            pc.ToDateTime(yy, mm, dd, 12, 0, 0, 0)
            MsgBox(fpd, 64)
        Catch
            MsgBox("تاریخ اشتباه است", 48)
        End Try

---

کد زیر در صورت 64 بیتی بودن سیستم عامل مقدار True و در غیر این صورت مقدار False را بر می گرداند:

کد:

---

Environment.Is64BitOperatingSystem

---