Visual Basic 2005

در این تاپیک، در مورد ویژوال بیسیک 2005 بحث خواهد شد. از دوستان عزیز هر کس در چهار چوب عنوانهای زیر، چیزی بلد هست در این جا پست نماید. از کاربران وارد به وی بی 2005، خواهش میکنم با حضور خود در این تاپیک، ما رو از معلومات خود بی نصیب نگذارند.
ممنون از لطف و عنایت شما.
Sample Codes
Components
Module
Class
Sample Projects
...

برای شروع، یک Module در مورد تول تیپ با قابلیت راست به چپ قرار میدم. این Module رو خودم نوشتم:

کد:

---

Module RTLToolTip
    Dim ToolTipForm As New Form
    Dim CurrentControl As New Control
    Dim Text As String
    Dim ToolTipLabel As New Label
    Dim ToolTipLabel_Title As New Label
    Dim AroundLabel As New Label
    Dim Timer As New Timer
    Dim t As Boolean = False
    Public DisplayTime As Integer = 3000
    Public Right_To_Left As Boolean = True
    Public Font As Font = New Font("Tahoma", 8, FontStyle.Regular)
    Public ForeColor As Drawing.Color = Color.Black
    Dim SavedToolTip As ToolTip = New ToolTip
    Public BackColor As Drawing.Color = SavedToolTip.BackColor  'Color.Cornsilk
    Public Title As String = Nothing
    Public ShutDown As Boolean = False
    Public Sub Display(ByRef Control As Control)
        Text = Nothing
        Text = SavedToolTip.GetToolTip(Control)
        SavedToolTip.Active = False
        If ShutDown = True Then Exit Sub
        If Len(Trim(Text)) = 0 Then Exit Sub
        CurrentControl = Nothing
        CurrentControl = Control
        'CurrentControl.Parent = Control.Parent
        AddHandler ToolTipForm.Load, AddressOf ToolTipForm_Load
        AddHandler CurrentControl.MouseLeave, AddressOf CurrentControl_MouseLeave
        'AddHandler CurrentControl.MouseMove, AddressOf CurrentControl_MouseMove
        AddHandler Timer.Tick, AddressOf Timer_Tick
        'CurrentControl_MouseMove(Nothing, Nothing)
        'ToolTipForm.Show()
        If t = True Then Exit Sub
        ToolTipForm_Load(Nothing, Nothing)

        If IsNumeric(DisplayTime) = False Then DisplayTime = 3000
        If DisplayTime < 0 Then DisplayTime = 3000
        Timer.Interval = DisplayTime + 1
        Timer.Enabled = True
    End Sub
    Private Sub ToolTipForm_Load(ByVal sender As System.Object, ByVal e As System.EventArgs)
        If ToolTipForm.Visible = True Then Exit Sub
        ToolTipForm.Width = 0
        ToolTipForm.Height = 0
        '===============================
        If Len(Trim(Title)) = 0 Then
            ToolTipLabel_Title.AutoSize = False
            ToolTipLabel_Title.Text = Nothing
            ToolTipLabel_Title.Height = 0
            ToolTipLabel_Title.Width = 0
            ToolTipLabel_Title.Visible = False
            GoTo TilteIsEmty
        End If
        ToolTipLabel_Title.Text = Title
        ToolTipLabel_Title.Font = New Font(Font.Name, 8, FontStyle.Bold)
        If Right_To_Left = True Then
            ToolTipLabel_Title.RightToLeft = RightToLeft.Yes
            ToolTipLabel_Title.TextAlign = ContentAlignment.MiddleLeft
        Else
            ToolTipLabel_Title.RightToLeft = RightToLeft.No
            ToolTipLabel_Title.TextAlign = ContentAlignment.MiddleLeft
        End If
        ToolTipLabel_Title.ForeColor = ForeColor
        ToolTipLabel_Title.BackColor = BackColor
        ToolTipLabel_Title.AutoSize = True
        ToolTipLabel_Title.BorderStyle = BorderStyle.None
        ToolTipLabel_Title.Visible = True
        ToolTipLabel_Title.Left = 1 : ToolTipLabel_Title.Top = 1
        ToolTipLabel_Title.Parent = ToolTipForm
        ToolTipLabel_Title.BringToFront()
        '===============================
TilteIsEmty:
        ToolTipLabel.Text = Text
        ToolTipLabel.Font = New Font(Font.Name, 8, FontStyle.Regular)
        If Right_To_Left = True Then
            ToolTipLabel.RightToLeft = RightToLeft.Yes
            ToolTipLabel.TextAlign = ContentAlignment.MiddleLeft
        Else
            ToolTipLabel.RightToLeft = RightToLeft.No
            ToolTipLabel.TextAlign = ContentAlignment.MiddleLeft
        End If
        ToolTipLabel.ForeColor = ForeColor
        ToolTipLabel.BackColor = BackColor
        ToolTipLabel.AutoSize = True
        ToolTipLabel.BorderStyle = BorderStyle.None
        ToolTipLabel.Visible = True
        ToolTipLabel.Left = 1 : ToolTipLabel.Top = ToolTipLabel_Title.Height + 4
        ToolTipLabel.Parent = ToolTipForm
        ToolTipLabel.BringToFront()
        If Right_To_Left = True Then
            If ToolTipLabel.Width >= ToolTipLabel_Title.Width Then
                ToolTipLabel_Title.Left = ToolTipLabel.Width - ToolTipLabel_Title.Width
            Else
                ToolTipLabel.Left = ToolTipLabel_Title.Width - ToolTipLabel.Width
            End If
        End If
       
        AroundLabel.BackColor = ToolTipLabel.BackColor
        AroundLabel.AutoSize = False
        AroundLabel.Text = " "
        If ToolTipLabel.Width >= ToolTipLabel_Title.Width Then
            AroundLabel.Width = ToolTipLabel.Width + 2
        Else
            AroundLabel.Width = ToolTipLabel_Title.Width + 2
        End If
        AroundLabel.Height = ToolTipLabel.Height + ToolTipLabel_Title.Height + 8
        AroundLabel.Left = 0 : AroundLabel.Top = 0
        AroundLabel.BorderStyle = BorderStyle.FixedSingle
        AroundLabel.Parent = ToolTipForm
        ToolTipForm.FormBorderStyle = FormBorderStyle.None
        ToolTipForm.BackColor = ToolTipLabel.BackColor
        ToolTipForm.ShowInTaskbar = False
        ToolTipForm.StartPosition = FormStartPosition.CenterScreen
        ToolTipForm.TopMost = True
        ToolTipForm.Visible = True
        ToolTipForm.Width = AroundLabel.Width
        ToolTipForm.Height = AroundLabel.Height
        ToolTipForm.Anchor = AnchorStyles.Bottom
        ToolTipForm.Left = Cursor.Position.X
        Dim H As Integer = 0
        If CurrentControl.Parent.FindForm.Top = CurrentControl.Parent.Top Then
            H = CurrentControl.Parent.Top + CurrentControl.Top - ToolTipForm.Height - 2
        Else
            H = CurrentControl.Parent.FindForm.Top + CurrentControl.Parent.Top + CurrentControl.Top - ToolTipForm.Height - 2
        End If
        Select Case CurrentControl.Parent.FindForm.FormBorderStyle
            Case FormBorderStyle.None
                H = H
            Case FormBorderStyle.Sizable
                H = H + 30
            Case FormBorderStyle.FixedSingle
                H = H + 28
            Case FormBorderStyle.Fixed3D
                H = H + 32
            Case FormBorderStyle.FixedDialog
                H = H + 28
            Case FormBorderStyle.FixedToolWindow
                H = H + 20
            Case FormBorderStyle.SizableToolWindow
                H = H + 22
        End Select
        ToolTipForm.Top = H
    End Sub
    Private Sub CurrentControl_MouseLeave(ByVal sender As Object, ByVal e As System.EventArgs)
        ToolTipForm.Visible = False
        t = False
        'My.Application.DoEvents()
    End Sub
    Private Sub Timer_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs)
        If Timer.Interval = 1 Then Exit Sub
        If t = True Then
            ToolTipForm.Visible = False
            Timer.Enabled = False
        End If
        t = True
    End Sub
    Public Sub SetToolTip(ByRef Control As Control, ByRef Text As String)
        If Len(Trim(Text)) = 0 Then Exit Sub
        SavedToolTip.SetToolTip(Control, Text)
    End Sub
    Public Function GetToolTip(ByRef Control As Control) As String
        GetToolTip = Nothing
        GetToolTip = SavedToolTip.GetToolTip(Control)
    End Function
End Module

---

یک قطعه کد جالب برای کد گذاری رو فایلها، که بوسیله اون میتونید فایل رو طوری تغییر بدبن که فقط توسط برنامه شما قابل خواندن و نوشتن باشه.
اصل کد مربوط به ورژنهای پایینتر بود که با بازنویسی و تغییرات لازم ، اونو برای وی بی 2005 هم قابل استفاده کردم.

کد:

---

Imports System.IO
Imports System.Security.Cryptography
Imports System.Text
Module Code_a_File
    Private Sub EncryptFile(ByVal sPassword As String, _
                                ByVal sOldFilePath As String, _
                                ByVal sNewFilePath As String)
        Try
            Dim oOldFileStream As New FileStream(sOldFilePath, FileMode.Open)
            Dim oNewFileStream As New FileStream(sNewFilePath, FileMode.Create)
            Dim oRijndaelManaged As New RijndaelManaged
            Dim sKey As Byte() = (New UnicodeEncoding).GetBytes(sPassword.PadRight(8, "*"))
            Dim oCryptoStream As New CryptoStream(oNewFileStream, _
                    oRijndaelManaged.CreateEncryptor(sKey, sKey), CryptoStreamMode.Write)
            Dim data As Integer
            While True
                data = oOldFileStream.ReadByte()
                If data = -1 Then Exit While
                oCryptoStream.WriteByte(CByte(data))
            End While
            oOldFileStream.Close()
            oCryptoStream.Close()
            oNewFileStream.Close()
        Catch
        End Try
        'MsgBox("Done")
    End Sub
    Private Sub DecryptFile(ByVal sPassword As String, _
                            ByVal sOldFilePath As String, _
                            ByVal sNewFilePath As String)
        Try
            Dim sKey As Byte() = (New UnicodeEncoding).GetBytes(sPassword.PadRight(8, "*"))
            Dim oOldFileStream As New FileStream(sOldFilePath, FileMode.Open)
            Dim oNewFileStream As New FileStream(sNewFilePath, FileMode.Create)
            Dim oRijndaelManaged As New RijndaelManaged
            Dim oCryptoStream As New CryptoStream(oOldFileStream, _
                oRijndaelManaged.CreateDecryptor(sKey, sKey), CryptoStreamMode.Read)
            Dim data As Integer
            While True
                data = oCryptoStream.ReadByte()
                If data = -1 Then Exit While
                oNewFileStream.WriteByte(CByte(data))
            End While
            oNewFileStream.Close()
            oCryptoStream.Close()
            oOldFileStream.Close()
        Catch
        End Try
        'MsgBox("Done")
    End Sub
End Module

---

module برای تاریخ شمسی با قابلیت تاریخ به حروف و عدد. این رو هم خودم نوشتم.

کد:

---

Module ShamsiDate
    Public Function WeekDayName() As String
        WeekDayName = ""
        If Date.Today.DayOfWeek = DayOfWeek.Friday Then WeekDayName = "جمعه"
        If Date.Today.DayOfWeek = DayOfWeek.Saturday Then WeekDayName = "شنبه"
        If Date.Today.DayOfWeek = DayOfWeek.Sunday Then WeekDayName = "یکشنبه"
        If Date.Today.DayOfWeek = DayOfWeek.Monday Then WeekDayName = "دوشنبه"
        If Date.Today.DayOfWeek = DayOfWeek.Tuesday Then WeekDayName = "سه شنبه"
        If Date.Today.DayOfWeek = DayOfWeek.Wednesday Then WeekDayName = "چهارشنبه"
        If Date.Today.DayOfWeek = DayOfWeek.Thursday Then WeekDayName = "پنج شنبه"
    End Function
    Public Function DayOfMonth() As Integer
        DayOfMonth = 0
        Select Case Date.Today.Month
            Case 1 'January = 31 Day
                If Date.Today.Day <= 20 Then DayOfMonth = Date.Today.Day + 10
                If Date.Today.Day > 20 Then DayOfMonth = Date.Today.Day - 20
                Exit Function
            Case 2 'February = 28 or 29 Day
                If Date.Today.Day <= 19 Then DayOfMonth = Date.Today.Day + 11
                If Date.Today.Day > 19 Then DayOfMonth = Date.Today.Day - 19
                Exit Function
            Case 3 'March = 31 Day
                Dim DD As Integer
                DD = 9
                If Date.IsLeapYear(Date.Today.Year) = True Then DD = 10
                If Date.Today.Day <= 20 Then DayOfMonth = Date.Today.Day + DD
                If Date.Today.Day > 20 Then DayOfMonth = Date.Today.Day - 20
                Exit Function
            Case 4 'April = 30 Day
                If Date.Today.Day <= 20 Then DayOfMonth = Date.Today.Day + 11
                If Date.Today.Day > 20 Then DayOfMonth = Date.Today.Day - 20
                Exit Function
            Case 5 'May = 31 Day
                If Date.Today.Day <= 21 Then DayOfMonth = Date.Today.Day + 10
                If Date.Today.Day > 21 Then DayOfMonth = Date.Today.Day - 21
                Exit Function
            Case 6 'June = 30 Day
                If Date.Today.Day <= 21 Then DayOfMonth = Date.Today.Day + 10
                If Date.Today.Day > 21 Then DayOfMonth = Date.Today.Day - 21
                Exit Function
            Case 7 'July = 31 Day
                If Date.Today.Day <= 22 Then DayOfMonth = Date.Today.Day + 9
                If Date.Today.Day > 22 Then DayOfMonth = Date.Today.Day - 22
                Exit Function
            Case 8 'August = 31 Day
                If Date.Today.Day <= 22 Then DayOfMonth = Date.Today.Day + 9
                If Date.Today.Day > 22 Then DayOfMonth = Date.Today.Day - 22
                Exit Function
            Case 9 'September = 30 Day
                If Date.Today.Day <= 22 Then DayOfMonth = Date.Today.Day + 9
                If Date.Today.Day > 22 Then DayOfMonth = Date.Today.Day - 22
                Exit Function
                Exit Function
            Case 10 'October = 31 Day
                If Date.Today.Day <= 22 Then DayOfMonth = Date.Today.Day + 8
                If Date.Today.Day > 22 Then DayOfMonth = Date.Today.Day - 22
                Exit Function
            Case 11 'November = 30 Day
                If Date.Today.Day <= 21 Then DayOfMonth = Date.Today.Day + 9
                If Date.Today.Day > 21 Then DayOfMonth = Date.Today.Day - 21
                Exit Function
            Case 12 'December = 31 Day
                If Date.Today.Day <= 21 Then DayOfMonth = Date.Today.Day + 9
                If Date.Today.Day > 21 Then DayOfMonth = Date.Today.Day - 21
                Exit Function
        End Select
    End Function
    Public Function MonthName() As String
        MonthName = ""
        Select Case Date.Today.Month
            Case 1 'January = 31 Day
                If Date.Today.Day <= 20 Then MonthName = "دی"
                If Date.Today.Day > 20 Then MonthName = "بهمن"
                Exit Function
            Case 2 'February = 28 or 29 Day
                If Date.Today.Day <= 19 Then MonthName = "بهمن"
                If Date.Today.Day > 19 Then MonthName = "اسفند"
                Exit Function
            Case 3 'March = 31 Day
                If Date.Today.Day <= 20 Then MonthName = "اسفند"
                If Date.Today.Day > 20 Then MonthName = "فروردین"
                Exit Function
            Case 4 'April = 30 Day
                If Date.Today.Day <= 20 Then MonthName = "فروردین"
                If Date.Today.Day > 20 Then MonthName = "اردیبهشت"
                Exit Function
            Case 5 'May = 31 Day
                If Date.Today.Day <= 21 Then MonthName = "اردیبهشت"
                If Date.Today.Day > 21 Then MonthName = "خرداد"
                Exit Function
            Case 6 'June = 30 Day
                If Date.Today.Day <= 21 Then MonthName = "خرداد"
                If Date.Today.Day > 21 Then MonthName = "تیر"
                Exit Function
            Case 7 'July = 31 Day
                If Date.Today.Day <= 22 Then MonthName = "تیر"
                If Date.Today.Day > 22 Then MonthName = "مرداد"
                Exit Function
            Case 8 'August = 31 Day
                If Date.Today.Day <= 22 Then MonthName = "مرداد"
                If Date.Today.Day > 22 Then MonthName = "شهریور"
                Exit Function
            Case 9 'September = 30 Day
                If Date.Today.Day <= 22 Then MonthName = "شهریور"
                If Date.Today.Day > 22 Then MonthName = "مهر"
                Exit Function
                Exit Function
            Case 10 'October = 31 Day
                If Date.Today.Day <= 22 Then MonthName = "مهر"
                If Date.Today.Day > 22 Then MonthName = "آبان"
                Exit Function
            Case 11 'November = 30 Day
                If Date.Today.Day <= 21 Then MonthName = "آبان"
                If Date.Today.Day > 21 Then MonthName = "آذر"
                Exit Function
            Case 12 'December = 31 Day
                If Date.Today.Day <= 21 Then MonthName = "آذر"
                If Date.Today.Day > 21 Then MonthName = "دی"
                Exit Function
        End Select
    End Function
    Public Function Year() As Integer
        If Date.Today.DayOfYear <= 79 Or Date.Today.DayOfYear > 286 Then
            Year = Date.Today.Year - 622
        Else
            Year = Date.Today.Year - 621
        End If
    End Function
    Public Function MonthNumber() As Integer
        MonthNumber = 0
        Select Case Date.Today.Month
            Case 1 'January = 31 Day
                If Date.Today.Day <= 20 Then MonthNumber = 10
                If Date.Today.Day > 20 Then MonthNumber = 11
                Exit Function
            Case 2 'February = 28 or 29 Day
                If Date.Today.Day <= 19 Then MonthNumber = 11
                If Date.Today.Day > 19 Then MonthNumber = 12
                Exit Function
            Case 3 'March = 31 Day
                If Date.Today.Day <= 20 Then MonthNumber = 12
                If Date.Today.Day > 20 Then MonthNumber = 1
                Exit Function
            Case 4 'April = 30 Day
                If Date.Today.Day <= 20 Then MonthNumber = 1
                If Date.Today.Day > 20 Then MonthNumber = 2
                Exit Function
            Case 5 'May = 31 Day
                If Date.Today.Day <= 21 Then MonthNumber = 2
                If Date.Today.Day > 21 Then MonthNumber = 3
                Exit Function
            Case 6 'June = 30 Day
                If Date.Today.Day <= 21 Then MonthNumber = 3
                If Date.Today.Day > 21 Then MonthNumber = 4
                Exit Function
            Case 7 'July = 31 Day
                If Date.Today.Day <= 22 Then MonthNumber = 4
                If Date.Today.Day > 22 Then MonthNumber = 5
                Exit Function
            Case 8 'August = 31 Day
                If Date.Today.Day <= 22 Then MonthNumber = 5
                If Date.Today.Day > 22 Then MonthNumber = 6
                Exit Function
            Case 9 'September = 30 Day
                If Date.Today.Day <= 22 Then MonthNumber = 6
                If Date.Today.Day > 22 Then MonthNumber = 7
                Exit Function
                Exit Function
            Case 10 'October = 31 Day
                If Date.Today.Day <= 22 Then MonthNumber = 7
                If Date.Today.Day > 22 Then MonthNumber = 8
                Exit Function
            Case 11 'November = 30 Day
                If Date.Today.Day <= 21 Then MonthNumber = 8
                If Date.Today.Day > 21 Then MonthNumber = 9
                Exit Function
            Case 12 'December = 31 Day
                If Date.Today.Day <= 21 Then MonthNumber = 9
                If Date.Today.Day > 21 Then MonthNumber = 10
                Exit Function
        End Select
    End Function
    Public Function Today() As String
        Today = ""
        Today = Year() & "/" & MonthNumber() & "/" & DayOfMonth()
    End Function
End Module

---

یک کلاس Power Off ویندوز با چندین قابلیت جالب. علاوه بر کارکردهای معمولی، میشه از اون به عنوان سر به سر گذاشتن کاربران هم استفاده کرد :46: ( البته توصیه نمیکنم )

کد:

---

Public Class Win_ShutDown
    Public Enum shutdownTypes
        Logoff = 0
        Shutdown = 1
        Reboot = 2
        Force = 4
        PowerOff = 8
    End Enum
    Private Structure LUID
        Dim UsedPart As Integer
        Dim IgnoredForNowHigh32BitPart As Integer
    End Structure
    Private Structure TOKEN_PRIVILEGES
        Dim PrivilegeCount As Integer
        Dim TheLuid As luID
        Dim Attributes As Integer
    End Structure
    Private Declare Function ExitWindowsEx Lib "user32" (ByVal shutdownType As Integer, ByVal dwReserved As _
        Integer) As Integer
    Private Declare Auto Function InitiateSystemShutdownEx Lib "Advapi32.dll" (ByVal lpMachineName As _
        String, ByVal lpMessage As String, ByVal dwTimeout As Integer, ByVal bForceAppsClosed As Boolean, _
            ByVal bRebootAfterShutdown As Boolean, ByVal dwReason As shutdownReason) As Boolean
    Public Enum shutdownReason
        SHTDN_REASON_MAJOR_APPLICATION = &H40000 'Application issue.
        SHTDN_REASON_MAJOR_HARDWARE = &H10000 'Hardware issue.
        SHTDN_REASON_MAJOR_LEGACY_API = &H70000 'The InitiateSystemShutdown function was used instead of InitiateSystemShutdownEx.
        SHTDN_REASON_MAJOR_OPERATINGSYSTEM = &H20000 'Operating system issue.
        SHTDN_REASON_MAJOR_OTHER = &H0    ' Other issue.
        SHTDN_REASON_MAJOR_POWER = &H60000 'Power failure.
        SHTDN_REASON_MAJOR_SOFTWARE = &H30000 'Software issue.
        SHTDN_REASON_MAJOR_SYSTEM = &H50000 'System failure
    End Enum
    Public Enum shutdownMethodToExecute
        ExitWindowsExAPI = 1
        ProcessShellMethod = 2
    End Enum
    Private Declare Auto Function AbortSystemShutdown Lib "Advapi32.dll" (ByVal lpMachineName As String) _
        As Boolean
    Private Declare Function OpenProcessToken Lib "advapi32" (ByVal ProcessHandle As IntPtr, ByVal _
        DesiredAccess As Integer, ByRef TokenHandle As Integer) As Integer
    Private Declare Function LookupPrivilegeValue Lib "advapi32" Alias "LookupPrivilegeValueA" (ByVal _
        lpSystemName As String, ByVal lpName As String, ByRef lpLuid As LUID) As Integer
    Private Declare Function AdjustTokenPrivileges Lib "advapi32" (ByVal TokenHandle As Integer, ByVal _
        DisableAllPrivileges As Boolean, ByRef NewState As TOKEN_PRIVILEGES, ByVal BufferLength As _
            Integer, ByRef PreviousState As TOKEN_PRIVILEGES, ByRef ReturnLength As Integer) As Integer
    Private Declare Function SHShutDownDialog Lib "shell32" Alias "#60" (ByVal notSureYet As Integer) As Integer
    Private Sub AdjustToken()
        Const TOKEN_ADJUST_PRIVILEGES As Int32 = &H20
        Const TOKEN_QUERY As Int32 = &H8
        Const SE_PRIVILEGE_ENABLED As Int32 = &H2
        Dim hdlProcessHandle As IntPtr
        Dim hdlTokenHandle As Int32
        Dim tmpLuid As LUID
        Dim tkp As TOKEN_PRIVILEGES
        Dim tkpNewButIgnored As TOKEN_PRIVILEGES
        Dim lBufferNeeded As Int32
        hdlProcessHandle = Process.GetCurrentProcess.Handle
        OpenProcessToken(hdlProcessHandle, (TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY), hdlTokenHandle)
        LookupPrivilegeValue("", "SeShutdownPrivilege", tmpLuid)
        tkp.PrivilegeCount = 1  'One privilege to set
        tkp.TheLuid = tmpLuid
        tkp.Attributes = SE_PRIVILEGE_ENABLED
        AdjustTokenPrivileges(hdlTokenHandle, False, tkp, Len(tkpNewButIgnored), tkpNewButIgnored, _
            lBufferNeeded)
    End Sub
    Public Function shutdownWindowsOS(ByVal shutdownType As shutdownTypes, Optional ByVal executeShutdownMethod As _
        shutdownMethodToExecute = shutdownMethodToExecute.ExitWindowsExAPI) As Integer
        Select Case executeShutdownMethod
            Case shutdownMethodToExecute.ExitWindowsExAPI
                AdjustToken()
                Return ExitWindowsEx(shutdownType, Nothing)
            Case Else
                If shutdownType = shutdownTypes.Shutdown Then
                    Process.Start("shutdown -s -f -t 0")
                    'Shell("shutdown -s -f -t 0", , False, 0)
                End If
                If shutdownType = shutdownTypes.Reboot Then
                    'Shell("shutdown -r -f -t 0", , False, 0)
                    Process.Start("shutdown -r -f -t 0")
                End If
                If shutdownType = shutdownTypes.Logoff Then
                    'Shell("shutdown -l -f -t 0", , False, 0)
                    Process.Start("shutdown -l -f -t 0")
                End If
        End Select
    End Function
    Public Function initiateSystemShutdownDialog(Optional ByVal computerName As String = "", Optional ByVal _
        shutdownMessage As String = "Computer needs to Shutdown", Optional ByVal shutdownTimeoutBySeconds _
            As Integer = 10, Optional ByVal forceShutdown As Boolean = False, Optional ByVal _
                rebootAfterShutdown As Boolean = True, Optional ByVal shutdownReason As shutdownReason = _
                    shutdownReason.SHTDN_REASON_MAJOR_APPLICATION) As Boolean
        AdjustToken()
        Return InitiateSystemShutdownEx(computerName, shutdownMessage, shutdownTimeoutBySeconds, _
            forceShutdown, rebootAfterShutdown, shutdownReason)
    End Function
    Public Function cancelInitiatedShutdownDialog(Optional ByVal computerName As String = "") As Boolean
        Return AbortSystemShutdown(computerName)
    End Function
    Public Function openTurnOffComputerDialog() As Integer
        Return SHShutDownDialog(0)
    End Function
End Class

---

بوسیله این Dll به راحتی تمامی فرمتهای موزیک در وی بی، قابل پخش خواهد بود.

[html]http://rapidshare.com/files/48354393/Music_Library.dll.html[/html]

برای این کار کافیست کد زیر رو در هر جایی از کد ادیتور که میخواهید بنویسید ( البته خارج از روال ها ) :

کد:

---

Private _closeClick AsBoolean

PublicConst SC_CLOSE AsInteger = 61536

PublicConst WM_SYSCOMMAND AsInteger = 274

ProtectedOverloadsOverridesSub WndProc(ByRef m As Message)
If m.Msg = WM_SYSCOMMAND AndAlso m.WParam.ToInt32 = SC_CLOSE Then

ExitSub

Else

Me._closeClick = True

EndIf

MyBase.WndProc(m)
EndSub

---

کد:

---

Dim

output AsString = ""

Dim msg AsString

Dim I AsInteger

Dim myEventLog AsNew EventLog
myEventLog.Log = "system"

I = myEventLog.Entries.Count - 1

While I >= 0
If myEventLog.Entries.Item(I).Source = "RemoteAccess"Then

msg = myEventLog.Entries.Item(I).Message

If InStr(msg, "successfully established") Then

output =

"You last connected to the network on: "

output &= myEventLog.Entries.Item(I).TimeWritten
msg = Mid(msg, InStr(msg,

"connection to") + 14)
msg = Microsoft.VisualBasic.Left(msg, InStr(msg, "using") - 2)
output &= vbNewLine & "The name of the connection used was: " & msg
ExitWhile

EndIf

EndIf

I -= 1

EndWhile

MsgBox(output)

EndSub

---

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

نقل قول:

---

برای شروع، یک Module در مورد تول تیپ با قابلیت راست به چپ قرار میدم.

---

وقتی خود دات نت راست به چپش و با آیکون و بدون آیکون و... را پشتیبانی میکند چه نیازی به کد فوق است!

نقل قول:

---

module برای تاریخ شمسی با قابلیت تاریخ به حروف و عدد

---

بدون شک اشتباه تبدیل میکند!
اصلاً من یک فتوی شرعی-برنامه نویسی میدهم! هر وقت کد تبدیل تاریخ دیدی که به کرات از اعداد 20 و 21 و22 استفاده کرده بود، مطمئن باشید که ایراد دارد. :31:
حداقل از PersianCalendar استفاده میکردید.

انشا ا... تداوم یابد، میبخشید که مجدداً فضولی کردم، موفق باشید!

نقل قول:

---

نوشته شده توسط _H2_ [ برای مشاهده لینک ، با نام کاربری خود وارد شوید یا ثبت نام کنید ]

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

---

بسیار خوشحال میشم ار انتقادات شما. ولی بهتره خودتون هم آستین بالا بزنید و ما رو از دانش خود بهره مند سازید.

نقل قول:

---

وقتی خود دات نت راست به چپش و با آیکون و بدون آیکون و... را پشتیبانی میکند چه نیازی به کد فوق است!

---

اصلا چنین چیزی وجود ندارد. علیرغم قدرت بالای تول تیپ در دات نت، متاسفانه امکانات RTL در اون تعبیه نشده است.

نقل قول:

---

بدون شک اشتباه تبدیل میکند!
اصلاً من یک فتوی شرعی-برنامه نویسی میدهم! هر وقت کد تبدیل تاریخ دیدی که به کرات از اعداد 20 و 21 و22 استفاده کرده بود، مطمئن باشید که ایراد دارد. :31:
حداقل از PersianCalendar استفاده میکردید.

---

در این مورد شاید حق با شما باشد. ولی آیا راه دیگری به ذهنتان میرسد؟ در ضمن PersianCalendar بسیار کامل است و موقعی که من Module مربوطه رو می نوشتم از وجود چنین چیزی باخبر نبودم :11:

نقل قول:

---

انشا ا... تداوم یابد، میبخشید که مجدداً فضولی کردم، موفق باشید!

---

بدون همکاری دوستان ، شاید نتونم ادامه بدم!

برای امکان حرکت دادن یا Moving کنترلها ، در هنگام اجرای برنامه کافیست روال زیر رو به پروژه اضافه کنید:

کد:

---

Private Sub MouseDragging(ByVal e As MouseEventArgs, ByVal Control As Control)

Static OldPosition AsNew Point(-1, -1)

IfNot (e.Button = Nothing) Then
If e.Button = Windows.Forms.MouseButtons.Left Then
If (OldPosition.X = -1) And (OldPosition.Y = -1) Then OldPosition = New Point(e.X, e.Y)
If e.Y <> OldPosition.Y Then
Control.Top += e.Y - OldPosition.Y

 

'move Up/Down

EndIf

If e.X <> OldPosition.X Then
Control.Left += e.X - OldPosition.X

 

'move Left/Right

End If

End If
Else
'button is nothing, maybe it was lifted.
OldPosition = New Point(-1, -1)

EndIf

EndSub

---

روش استفاده:

یک کنترل از نوع Button روی فرم فرار دهید و در رویداد MouseMove کد زیر را وارد نمایید:

MouseDragging(e, Button1)X

تغییر به فارسی:

کد:

---

Dim myCulture AsNew Globalization.CultureInfo("fa-IR")
InputLanguage.CurrentInputLanguage = InputLanguage.FromCulture(myCulture)

---

تغییر به انگلیسی:

کد:

---

Dim myCultureen AsNew Globalization.CultureInfo("En-Us")
InputLanguage.CurrentInputLanguage = InputLanguage.FromCulture(myCultureen)

---

اول

add referenced ->system.management.dll رو add کنيد.

سپس کد زير رو در کد اديتور بنويسيد:

کد:

---

Imports system.management
Public Class Form1
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As _
System.EventArgs) Handles MyBase.Load
Dim dtmInstallDate As DateTime
Dim pc As New System.Globalization.PersianCalendar
Dim oSearcher As New ManagementObjectSearcher _
("SELECT * FROM Win32_OperatingSystem")
For Each oMgmtObj As ManagementObject In oSearcher.Get
dtmInstallDate = ManagementDateTimeConverter.ToDateTime _
(CStr(oMgmtObj("InstallDate")))
Msgbox  (dtmInstallDate)
Next

End Sub
End Class

---

[ برای مشاهده لینک ، با نام کاربری خود وارد شوید یا ثبت نام کنید ]

سلام
این را برای یک سایت یکی از دوستانم نوشته بودم که عیناً در اینجا هم کپی کردم.
تبدیل به میلادی

کد:

---

Dim x As New System.Globalization.PersianCalendar
Dim dt As Date = x.ToDateTime(1386, 1, 1, 0, 0, 0, 0, 0)

---

تبدیل از میلادی

کد:

---

Dim x As New System.Globalization.PersianCalendar()
 
Dim dt As Date
dt = #1/1/2007#
'Or یا
dt = New Date(2007, 1, 1)
'Or یا
dt = CDate("1/1/2007")
 
Dim y As Integer = x.GetYear(dt)
Dim m As Integer = x.GetMonth(dt)
Dim d As Integer = x.GetDayOfMonth(dt)

---

برای تبدیل از/به میلادی بر اساس تقویم های دیگرف کافیست به جای کلاسس PersianCalendar کلاسس تقویم مورد نظر را نمونه سازی کرد.
دات نت 2 با تقویم میلادی در کل شامل 11 تقویم است!
مثلاً PersianCalendar تقویم ایرانی یا همان هجری شمسی است
یا HijriCalendar تقویم هجری قمری است
JapaneseCalendar ژاپنی
KoreanCalendar کره ای
TaiwanCalendar تایوانی
و...

برای تبدیل تاریخ های تقویم های دیگر به هم (که یک سرش میلادی نباشد) باید اول تاریخ مورد نظر را به میلادی تبدیل کرد و سپس میلادی را به تقویم دوم تبدیل کرد.

برای تبدیل به نام روزها و ماه هم بهتر است از آرایه String استفاده کنید نه دستورات IF و یا Select
یک آرایه 12 عنصری که مثلاً نام تمام ماه ها را دارد و فقط کافیست ایندکس را بدهید.....

نقل قول:

---

نوشته شده توسط shalineh [ برای مشاهده لینک ، با نام کاربری خود وارد شوید یا ثبت نام کنید ]

بوسیله این Dll به راحتی تمامی فرمتهای موزیک در وی بی، قابل پخش خواهد بود.

[html]http://rapidshare.com/files/48354393/Music_Library.dll.html[/html]

---

چرا من هر موقع می خوام از این استفاده کنم می گه این ماژول مال ماکروسافت دات نت نیست؟؟؟؟!!!

من اول روی یکی از قسمت های تول باکس کلیک راست می کنم و با ادد اند ریموو از دگمه براز این ماژول را انتخاب می کنم درسته؟؟

راستی چطور می شه یه ماژول را توی وی بی صدا زد>؟

نقل قول:

---

نوشته شده توسط shalineh [ برای مشاهده لینک ، با نام کاربری خود وارد شوید یا ثبت نام کنید ]

برای این کار کافیست کد زیر رو در هر جایی از کد ادیتور که میخواهید بنویسید ( البته خارج از روال ها ) :

کد:

---

Private _closeClick AsBoolean

PublicConst SC_CLOSE AsInteger = 61536

PublicConst WM_SYSCOMMAND AsInteger = 274

ProtectedOverloadsOverridesSub WndProc(ByRef m As Message)
If m.Msg = WM_SYSCOMMAND AndAlso m.WParam.ToInt32 = SC_CLOSE Then

ExitSub

Else

Me._closeClick = True

EndIf

MyBase.WndProc(m)
EndSub

---

---

این کارو میشه به همین راحتی انجام داد ! ! !


Private Sub Form1_FormClosing(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
e.Cancel = -1
End Sub

نقل قول:

---

نوشته شده توسط haj_hamid [ برای مشاهده لینک ، با نام کاربری خود وارد شوید یا ثبت نام کنید ]

این کارو میشه به همین راحتی انجام داد ! ! !


Private Sub Form1_FormClosing(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
e.Cancel = -1
End Sub

---

در این صورت دیگه با دستور Close هیچ یک از فرمهای برنامه رو نمیتونی ببندی.

نقل قول:

---

نوشته شده توسط _H2_ [ برای مشاهده لینک ، با نام کاربری خود وارد شوید یا ثبت نام کنید ]

برای تبدیل از/به میلادی بر اساس تقویم های دیگرف کافیست به جای کلاسس PersianCalendar کلاسس تقویم مورد نظر را نمونه سازی کرد.
دات نت 2 با تقویم میلادی در کل شامل 11 تقویم است!
مثلاً PersianCalendar تقویم ایرانی یا همان هجری شمسی است
یا HijriCalendar تقویم هجری قمری است
JapaneseCalendar ژاپنی
KoreanCalendar کره ای
TaiwanCalendar تایوانی
و...

برای تبدیل تاریخ های تقویم های دیگر به هم (که یک سرش میلادی نباشد) باید اول تاریخ مورد نظر را به میلادی تبدیل کرد و سپس میلادی را به تقویم دوم تبدیل کرد.

برای تبدیل به نام روزها و ماه هم بهتر است از آرایه String استفاده کنید نه دستورات IF و یا Select
یک آرایه 12 عنصری که مثلاً نام تمام ماه ها را دارد و فقط کافیست ایندکس را بدهید.....

---

قبلا عرض کردم که در این مورد حق با شماست. موقعی که داشتم اون Module تاریخ رو مینوشتم، از وجود PersianCalendar در ویژوال بیسیک 2005 مطلع نبودم.
ممنون از توجه شما.

نقل قول:

---

نوشته شده توسط farshad_momtaz [ برای مشاهده لینک ، با نام کاربری خود وارد شوید یا ثبت نام کنید ]

چرا من هر موقع می خوام از این استفاده کنم می گه این ماژول مال ماکروسافت دات نت نیست؟؟؟؟!!!

من اول روی یکی از قسمت های تول باکس کلیک راست می کنم و با ادد اند ریموو از دگمه براز این ماژول را انتخاب می کنم درسته؟؟

---

در وی بی 2005 ، برای استفاده از توابع یک DLL باید از منوی Project ---> Add References فایل مربوطه رو به پروژه اضافه کنی.

نقل قول:

---

نوشته شده توسط farshad_momtaz [ برای مشاهده لینک ، با نام کاربری خود وارد شوید یا ثبت نام کنید ]

راستی چطور می شه یه ماژول را توی وی بی صدا زد>؟

---

اسم Module رو بنویس و نقطه بذار، وی بی تمام توابع Module رو واست لیست میکنه .
راه دیگه اینه که اگه تابعی در یک Module به صورت Public تعریف شده باشه، میتونی اون تابع یا فانکشن رو به صورت مستقیم هم صدا بزنی.

یک OCX جالب برای چاپ کردن فرم برنامه که توسط شرکت مایکروسافت ارائه شده است.

[html]http://shalineh.parsaspace.com/Files/PrintForm.zip[/html]

البته این کار با کدنویسی هم مقدوره که بعدا همینجا اونو پست خواهم کرد.

نقل قول:

---

نوشته شده توسط shalineh [ برای مشاهده لینک ، با نام کاربری خود وارد شوید یا ثبت نام کنید ]

در این صورت دیگه با دستور Close هیچ یک از فرمهای برنامه رو نمیتونی ببندی.

---

در اینصورت فقط همین فرم رو نمیتونی با دستور Close ببندی
که اگه فرم اصلی باشه میتونی با دستور End پروژه رو خاتمه بدی

سلام
در مورد تقویم نخواستم بگویم شما اشتباه میکنید، فقط گفتم کدش را برای عموم بگذارم (گرچه خیلی ساده است!)

در مورد ToolTip و چند مورد دیگر یک پست داده بودم، ولی نمیدانم برای چه از طرف یکی از مدیران حذف شد!
به نظر خودم که ایرادی نداشت! من لحن شوختبعانه را به جدی ترجیح میدهم و همیشه هم از تعادلش سعی میکنم خارج نشوم و تازه حداقل میتوانستند قسمت مشکل دار را ویرایش کنند!
بهر حال حتماً آنها دلیلی داشته اند.

پس فقط در مورد ToolTip باید بگویم که دو راه دارد که ساده ترین آن تنظیم RightToLeft کل فرمتان است، در نتیجه نیازی به مازول خارجی نخواهید داشت.

جابجا کردن فرم بدون نوار عنوان و با قابليت چسبندگی (Dock)



نکته: در اين کد جابجايی توسط کليک بر روی picturebox انجام ميگيره که بجای اون هرچيزی ميشه گزاشت

کد:

---

 

 'Pic1 as pictureBox
    Dim a As Integer
    Dim b As Integer
    Public ScreenWidth As Integer = System.Windows.Forms.Screen.PrimaryScreen.Bounds.Width
    Public screenHeight As Integer = System.Windows.Forms.Screen.PrimaryScreen.Bounds.Height
    Dim newPoint As New System.Drawing.Point()
    Private Sub Pic1_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Pic1.MouseDown
        a = Control.MousePosition.X - Me.Location.X
        b = Control.MousePosition.Y - Me.Location.Y
    End Sub
    Private Sub Pic1_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Pic1.MouseMove
        If e.Button = MouseButtons.Left Then


            newPoint = Control.MousePosition
            newPoint.X = newPoint.X - (a)
            newPoint.Y = newPoint.Y - (b)
            Me.Location = newPoint
            'Docks Form top left and right corners
            If Me.Location.X < 8 And Me.Location.Y < 8 Then
                Me.Location = New System.Drawing.Point(0, 0)
            End If

            If Me.Location.X > (ScreenWidth - (Me.Size.Width)) + 8 And Me.Location.Y < 8 Then
                Me.Location = New Point(ScreenWidth - Me.Size.Width, 0)
            End If

        End If
    End Sub

---

شاید یکم از امکانات جدید VB.NET 2005 هم بگیم بد نباشه
شاید این لینک هم بد نیاشه برای انجمن برنامه نویسان هست که یکی از دوستان زحمت اون را کشید بودن
کپی نمی کنم چون کاردرستی نیست با اینکه منبع اغلب اون ها مایکروسافت هست

کد:

---

http://barnamenevis.org/forum/showthread.php?t=19858

---

اين كد فرم را شبيه يك دايره ميكند

کد:

---

    Protected Overrides Sub OnPaint( _
      ByVal e As System.Windows.Forms.PaintEventArgs)
        Dim shape As New System.Drawing.Drawing2D.GraphicsPath
        shape.AddEllipse(0, 0, Me.Width, Me.Height)
        Me.Region = New System.Drawing.Region(shape)
    End Sub

---

کد:

---

'Printing Data From ListView
Imports System.Drawing.Printing
Dim tableFont, titlefont, headfont As Font
Dim X1, X2, X3 As Integer
Dim W1, W2, W3 As Integer
Dim Y As Integer
Dim itm As Integer
�I Create this Sub for set the
Fontname,FontSize,Paper Setting
Public Sub PrintBIll()
Dim PSize As Integer = ListItems.Items.Count
Dim PHi As Double
With PrintDocument1.DefaultPageSettings
Dim Ps As PaperSize
PHi = PSize * 20 + 350
Ps = New PaperSize("Cust", 800, PHi)
.Margins.Top = 15
.Margins.Bottom = 20
.PaperSize = Ps
End With
headfont = New Font("Courier New", 16, FontStyle.Bold)
tableFont = New Font("Courier New", 10)
titlefont = New Font("Courier New", 12, FontStyle.Bold)
X1 = PrintDocument1.DefaultPageSettings.Margins.Left
Dim pageWidth As Integer
With PrintDocument1.DefaultPageSettings
pageWidth = .PaperSize.Width - .Margins.Left - .Margins.Right
End With
X2 = X1 + 120
X3 = X2 + pageWidth * 0.5
W1 = X2 - X1
W2 = X3 - X2
W3 = pageWidth - X3
�If u want to print Directly then
PrintDocument1.Print()
�Elseif u want print after print preview then u pls use this code
PrintPreviewDialog1.Document = PrintDocument1
PrintPreviewDialog1.ShowDialog()
itm = 0
End Sub
�==============================================� �Printing Current Document s Private Sub PrintDocument1_PrintPage(ByVal sender As System.Object, ByVal e As System.Drawing.Printing.PrintPageEventArgs) Handles PrintDocument1.PrintPage
Y = PrintDocument1.DefaultPageSettings.Margins.Top + 10
e.Graphics.DrawString("INVOICE", headfont, Brushes.Black, X1 + 250, Y)
e.Graphics.DrawString("Cash/Credit Bill ", titlefont, Brushes.Black, X1, Y + 50)
e.Graphics.DrawString("To : " & txtCustomername.Text, titlefont, Brushes.Black, X1, Y + 80)
e.Graphics.DrawString("Date : " & Format(DTsale.Value, "dd-MM-yyyy"), titlefont, Brushes.Black, X1 + 450, Y + 25)
e.Graphics.DrawString("Bill No : " & txtReference.Text, titlefont, Brushes.Black, X1 + 450, Y + 50)
Y = PrintDocument1.DefaultPageSettings.Margins.Top + 120
With PrintDocument1.DefaultPageSettings
e.Graphics.DrawLine(Pens.Black, .Margins.Left, Y + 20, _ .PaperSize.Width - .Margins.Right, Y + 20)
End With
e.Graphics.DrawString("SNO", titlefont, Brushes.Black, X1, Y)
e.Graphics.DrawString("NAME", titlefont, Brushes.Black, X2 - 50, Y)
e.Graphics.DrawString("QTY", titlefont, Brushes.Black, X2 + 220, Y)
e.Graphics.DrawString("RATE", titlefont, Brushes.Black, X2 + 280, Y)
e.Graphics.DrawString("MRP", titlefont, Brushes.Black, X2 + 345, Y)
e.Graphics.DrawString("TOTAL", titlefont, Brushes.Black, X2 + 425, Y)
Y = Y + 30
While itm < ListItems.Items.Count
'Listitems=Listview1
Dim str As String
'str = ListItems.Items(itm).Text
e.Graphics.DrawString(itm + 1, tableFont, Brushes.Black, X1, Y)
str = ListItems.Items(itm).SubItems(1).Text
Dim R As New RectangleF(X2 - 50, Y, W2, 80)
e.Graphics.DrawString(str, tableFont, Brushes.Black, R)
str = ListItems.Items(itm).SubItems(4).Text
Dim k As New RectangleF(X2 + 220, Y, W2, 80)
e.Graphics.DrawString(str, tableFont, Brushes.Black, k)
str = ListItems.Items(itm).SubItems(5).Text
Dim M As New RectangleF(X2 + 235, Y, W2, 80)
e.Graphics.DrawString(str, tableFont, Brushes.Black, M)
str = Format(ListItems.Items(itm).SubItems(7).Text, "Fixed")
Dim N As New RectangleF(X2 + 280, Y, W2, 80)
e.Graphics.DrawString(str, tableFont, Brushes.Black, N)
''''''
str = Format(ListItems.Items(itm).SubItems(6).Text, "Fixed")
Dim L As New RectangleF(X2 + 340, Y, W2, 80)
e.Graphics.DrawString(str, tableFont, Brushes.Black, L)
str = SetSpacing(Format(ListItems.Items(itm).SubItems(8).Text, "Fixed"), 10)
Dim O As New RectangleF(X2 + 400, Y, W2, 80)
e.Graphics.DrawString(str, tableFont, Brushes.Black, O)
Dim lines, Cols As Integer
e.Graphics.MeasureString(str, tableFont, New SizeF(W2, 50), _ New StringFormat(), Cols, lines)
Dim Yc As Integer
Yc = Y
Y = Y + lines * tableFont.Height + 5
Y = Math.Max(Y, Yc)
itm = itm + 1
End While
e.Graphics.DrawString("Net Amount : " & SetSpacing(Format(txtNetAmount.Text, "Fixed"), 10), titlefont, Brushes.Black, X2 + 240, Y + 15)
e.Graphics.DrawString("Roundof : " & SetSpacing(Format(txtRounof.Text, "Fixed"), 10), titlefont, Brushes.Black, X2 + 240, Y + 35)
e.Graphics.DrawString("Paid Amount : " & SetSpacing(Format(txtPaymentAmount.Text, "Fixed"), 10), titlefont, Brushes.Black, X2 + 240, Y + 55)
e.Graphics.DrawString("Balance : " & SetSpacing(Format(txtbalance.Text, "Fixed"), 10), titlefont, Brushes.Black, X2 + 240, Y + 75)
e.Graphics.DrawString("", titlefont, Brushes.White, X2 + 240, Y + 105) End Sub

---

پیدا کردن IP Address

کد:

---

Dim h As System.Net.IPHostEntry = System.Net.Dns.GetHostByName(System.Net.Dns.GetHostName)
 Console.WriteLine(CType(h.AddressList.GetValue(0), IPAddress).ToString)

---

تبديل مبناي 2 به 10 در VB.NET

کد:

---

Dim a, x, i, sum As Integer

        i = 1
        sum = 0

        a = TextBox1.Text()

        While (a <> 0)
            x = a Mod 10
            a = a / 10
            sum += x * i
            i *= 2
        End While

        MessageBox.Show(sum)

---

چگونه مي توان ميان كنترلهاي يك فرم بخصوص TextBox هاي آن حركت كرد؟ (البته با زدن كليد Enter)
دو راه حل وجود دارد:
1- در رويداد KeyDown هر كنترل دستورات زير را بنويسيد:

کد:

---

If e.KeyCode = Keys.Enter Then
            نام كنترل بعدي.Focus()
        End If

---

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

2- ابتدا خاصيت KeyPreview فرم را به True تغيير دهيد سپس در رويداد KeyDown فرم دستورات زير را بنويسيد:

کد:

---

If e.KeyCode = Keys.Enter Then
            Dim Con As Control
            Con = Me.GetNextControl(Me.ActiveControl, True)
            Con.Focus()
        End If

---

توضيح :
دستور Me.ActiveControl نام كنترلي كه Focus را در اختيار دارد برمي گرداند ودستورMe.GetNextControl نام كنترل بعدي را كه Focus را در اختيار مي گيرد برمي گرداند ودر Con قرار مي دهد و دستورCon.Focus باعث مي شود تا Focus در اختيار كنترل قرار گيرد.

نكته : فراموش نكنيد براي صحيح كاركردن دستورات بالا بايد خاصيت TabIndex هركنترل به درستي تنظيم شده باشد.

کد:

---

Private Function Multiply(ByVal TX1 As String, ByVal TX2 As String) As String
        Dim a(5), b(5), c(5) As Byte
        Dim S1, S2 As String

        If TX1 = "0" Or TX2 = "0" Then
            Return "0"
        Else
            S1 = TX1
            S2 = TX2

            ReDim a(S1.Length - 1)
            ReDim b(S2.Length - 1)

            If S1.Length >= S2.Length Then
                ReDim c(S1.Length * 2 - 1)
            Else
                ReDim c(S2.Length * 2 - 1)
            End If

            Dim i1 As Short = 0

            For i As Short = S1.Length - 1 To 0 Step -1
                a(i1) = S1.Chars(i).ToString
                i1 += 1
            Next

            i1 = 0

            For i As Short = S2.Length - 1 To 0 Step -1
                b(i1) = S2.Chars(i).ToString
                i1 += 1
            Next

            Dim k, t, t1, x As Short

            For i As Short = 0 To S1.Length - 1
                k = i
                t = 0
                t1 = 0
                For j As Short = 0 To S2.Length - 1
                    x = a(i) * b(j) + t
                    c(k) += x Mod 10 + t1
                    If t1 <> 0 Then
                        t1 = 0
                    End If
                    If c(k) >= 10 Then
                        t1 = c(k) \ 10
                        c(k) = c(k) Mod 10
                    End If
                    t = x \ 10
                    k += 1
                Next
                c(k) = t + t1
            Next

            Dim S3 As String
            Dim flag As Boolean = False

            For i As Short = UBound(c) To 0 Step -1
                If c(i) <> 0 Then
                    S3 &= c(i)
                    flag = True
                Else
                    If flag = True Then
                        S3 &= c(i)
                    End If
                End If
            Next

            Return S3
        End If
    End Function

---

کد:

---

Public Class iCam
#Region "Api/constants"

    Private Const WS_CHILD As Integer = &H40000000
    Private Const WS_VISIBLE As Integer = &H10000000
    Private Const SWP_NOMOVE As Short = &H2S
    Private Const SWP_NOZORDER As Short = &H4S
    Private Const WM_USER As Short = &H400S
    Private Const WM_CAP_DRIVER_CONNECT As Integer = WM_USER + 10
    Private Const WM_CAP_DRIVER_DISCONNECT As Integer = WM_USER + 11
    Private Const WM_CAP_SET_VIDEOFORMAT As Integer = WM_USER + 45
    Private Const WM_CAP_SET_PREVIEW As Integer = WM_USER + 50
    Private Const WM_CAP_SET_PREVIEWRATE As Integer = WM_USER + 52
    Private Const WM_CAP_GET_FRAME As Long = 1084
    Private Const WM_CAP_COPY As Long = 1054
    Private Const WM_CAP_START As Long = WM_USER
    Private Const WM_CAP_STOP As Long = (WM_CAP_START + 68)
    Private Const WM_CAP_SEQUENCE As Long = (WM_CAP_START + 62)
    Private Const WM_CAP_SET_SEQUENCE_SETUP As Long = (WM_CAP_START + 64)
    Private Const WM_CAP_FILE_SET_CAPTURE_FILEA As Long = (WM_CAP_START + 20)

    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Short, ByVal lParam As String) As Integer
    Private Declare Function capCreateCaptureWindowA Lib "avicap32.dll" (ByVal lpszWindowName As String, ByVal dwStyle As Integer, ByVal x As Integer, ByVal y As Integer, ByVal nWidth As Integer, ByVal nHeight As Short, ByVal hWndParent As Integer, ByVal nID As Integer) As Integer
    Private Declare Function capGetDriverDescriptionA Lib "avicap32.dll" (ByVal wDriver As Short, ByVal lpszName As String, ByVal cbName As Integer, ByVal lpszVer As String, ByVal cbVer As Integer) As Boolean
    Private Declare Function BitBlt Lib "GDI32.DLL" (ByVal hdcDest As IntPtr, ByVal nXDest As Integer, ByVal nYDest As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal hdcSrc As IntPtr, ByVal nXSrc As Integer, ByVal nYSrc As Integer, ByVal dwRop As Int32) As Boolean

#End Region

    Private iDevice As String
    Private hHwnd As Integer
    Private lwndC As Integer

    Public iRunning As Boolean

    Private CamFrameRate As Integer = 15
    Private OutputHeight As Integer = 240
    Private OutputWidth As Integer = 360

    Public Sub resetCam()
        'resets the camera after setting change
        If iRunning Then
            closeCam()
            Application.DoEvents()

            If setCam() = False Then
                MessageBox.Show("Errror Setting/Re-Setting Camera")
            End If
        End If

    End Sub

    Public Sub initCam(ByVal parentH As Integer)
        'Gets the handle and initiates camera setup
        If Me.iRunning = True Then
            MessageBox.Show("Camera Is Already Running")
            Exit Sub
        Else

            hHwnd = capCreateCaptureWindowA(iDevice, WS_VISIBLE Or WS_CHILD, 0, 0, OutputWidth, CShort(OutputHeight), parentH, 0)


            If setCam() = False Then
                MessageBox.Show("Error setting Up Camera")
            End If
        End If
    End Sub

    Public Sub setFrameRate(ByVal iRate As Long)
        'sets the frame rate of the camera
        CamFrameRate = CInt(1000 / iRate)

        resetCam()

    End Sub

    Private Function setCam() As Boolean
        'Sets all the camera up
        If SendMessage(hHwnd, WM_CAP_DRIVER_CONNECT, CShort(iDevice), CType(0, String)) = 1 Then
            SendMessage(hHwnd, WM_CAP_SET_PREVIEWRATE, CShort(CamFrameRate), CType(0, String))
            SendMessage(hHwnd, WM_CAP_SET_PREVIEW, 1, CType(0, String))
            Me.iRunning = True
            Return True
        Else
            Me.iRunning = False
            Return False
        End If
    End Function

    Public Function closeCam() As Boolean
        'Closes the camera
        If Me.iRunning Then
            closeCam = CBool(SendMessage(hHwnd, WM_CAP_DRIVER_DISCONNECT, 0, CType(0, String)))
            Me.iRunning = False
        End If
    End Function

    Public Function copyFrame(ByVal src As PictureBox, ByVal rect As RectangleF) As Bitmap
        If iRunning Then
            Dim srcPic As Graphics = src.CreateGraphics
            Dim srcBmp As New Bitmap(src.Width, src.Height, srcPic)
            Dim srcMem As Graphics = Graphics.FromImage(srcBmp)


            Dim HDC1 As IntPtr = srcPic.GetHdc
            Dim HDC2 As IntPtr = srcMem.GetHdc

            BitBlt(HDC2, 0, 0, CInt(rect.Width), _
              CInt(rect.Height), HDC1, CInt(rect.X), CInt(rect.Y), 13369376)

            copyFrame = CType(srcBmp.Clone(), Bitmap)

            'Clean Up
            srcPic.ReleaseHdc(HDC1)
            srcMem.ReleaseHdc(HDC2)
            srcPic.Dispose()
            srcMem.Dispose()
        Else
            MessageBox.Show("Camera Is Not Running!")
        End If
    End Function

    Public Function FPS() As Integer
        Return CInt(1000 / (CamFrameRate))
    End Function

End Class

---

منبع:

کد:

---

http://barnamenevis.org/forum/showpost.php?p=355455&postcount=55

---

کد:

---

Dim ChangeRes As Resolution.CResolution
Dim XRes AsShort = System.Windows.Forms.Screen.PrimaryScreen.Bounds.Width
Dim YRes AsShort = System.Windows.Forms.Screen.PrimaryScreen.Bounds.Height
ChangeRes = New Resolution.CResolution(800, 600)

---

روي فرم يک کنترل وب بروزر قرار دهيد و کد هاي زير را وارد کنيد:

کد:

---

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

WebBrowser1.Navigate("http://www.google.com")
End Sub

Private Sub webControl_DocumentCompleted(ByVal sender As Object, ByVal e As System.Windows.Forms.WebBrowserDocumentCompletedEventArgs) Handles WebBrowser1.DocumentCompleted

Dim link As HtmlElement

Dim links As HtmlElementCollection = WebBrowser1.Document.Links

For Each link In links

link.AttachEventHandler("onclick", AddressOf LinkClicked)
Next

End Sub

Private Sub LinkClicked(ByVal sender As Object, ByVal e As EventArgs)
Dim link As HtmlElement = WebBrowser1.Document.ActiveElement

Dim url As String = link.GetAttribute("href")
MsgBox("Link Clicked: " & link.InnerText & vbCrLf & _
"Destination: " & url)
End Sub

---

کد زیر رو در روال Form_Load قرار داده و برنامه رو اجرا کنید. عکس گرفته شده در درایو C ذخیره خواهد شد.

کد:

---

Dim b As Bitmap
b = Nothing
b = New Bitmap(Screen.PrimaryScreen.WorkingArea.Width, Screen.PrimaryScreen.WorkingArea.Height)
Dim g As Graphics = Graphics.FromImage(b)
Dim s As Size = New Size(Screen.PrimaryScreen.WorkingArea.Width, Screen.PrimaryScreen.WorkingArea.Height)
Dim t As DateTime = Now.AddSeconds(1)
Do : Application.DoEvents()
Loop Until Now.Second >= t.Second
g.CopyFromScreen(0, 0, 0, 0, s, CopyPixelOperation.SourceCopy)
t = Nothing
g.Dispose()
b.Save("C:\Desk.jpg")
End

---

در نسخه جدید وی بی ( ورژن 8 یا وی بی 2005 ) کلاس جدیدی تعبیه شده است که توابع جالبی دارد.

پخش یک فایل از نوع Wav ( فایل صوتی) : My.Computer.Audio
تابع مخصوص کار با کلیپ برد ( پاک کردن، فراخوانی، ذخیره، ویرایش و ... ) : My.Computer.Clipboard
به دست آوردن تایم فعلی سیستم ( ساعت GMT و ساعت محلی ) : My.Computer.Clock
انجام کارهای سیستمیک با فایل ( کپی، کات، حذف،انتقال، ایجاد دایرکتوری و ...): My.Computer.FileSystem
اطلاعات سیستم ( نام و ورژن سیستم عامل، مقدار حافظه مجازی و واقعی، ... ): My.Computer.Info
تعیین روشن یا خاموش بودن کلیدهای Caps Lock, Num Lock ,Scroll Lock و ... : My.Computer.Keyboard
توابع کار با ماوس ( سوئیچ کردن کلیدهای راست و چپ و ...) : My.Computer.Mouse
به دست آوردن نام کامپیوتر : My.Computer.Name
کار با شبکه و نت ( دانلود فایل، تعیین کانکت بودن و ... ) : My.Computer.Network
باز کردن پورت های سریال و نیز به دست آوردن نام یک پورت : My.Computer.Ports
تابع کار با رجیستری ( افزودن،ویرایش،حذف یک کلید یا زیر کلید از رجیستری و ... ) : My.Computer.Registry
به دست آوردن مختصات صفحه نمایش، نام و مشخصات کارت گرافیک و ... ) : My.Computer.Screen

1) با استفاده از تابع SetAttr مربوط به ويژوال بيسيک

کد:

---

SetAttr("FilePath", FileAttribute.Hidden))

---

2) با استفاده از توابع کتابخانه کلاس دات نت

کد:

---

Dim MyFile As New FileInfo("FilePath")
MyFile.Attributes = FileAttributes.Hidden

---

ابتدا دستور زیر را وارد کنید:

کد:

---

Imports System.Collections.ObjectModel

---

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

کد:

---

Private Function Find_In_Files(ByVal Directory AsString, _
ByVal SearchFor AsString) As Collection

Find_In_Files = Nothing

Dim file_names As ReadOnlyCollection(OfString)

file_names = My.Computer.FileSystem.FindInFiles( _
Directory, SearchFor, True, _
FileIO.SearchOption.SearchAllSubDirectories)
ForEach file_name AsStringIn file_names
Find_In_Files.Add(file_name)
Next file_name
EndFunction

---

سلام
انقدر سوال دارم که نمیدونم چیشون کنم
اول : چه جوری کاری کنم که وقتی روی دکم منی مایز کلیک شد برنامه به قسمت سیستم ترای بره
دوم: چه جوری کاری کنم که شخصیت مرلین قسمت های مختلف برنامه رو توضیح بده
سوم: چه طور فایل های داخل یه دایرکتوری رو نمایش بدم و با یه دکمه پاکشیون کنم ( مثلا با زدن دکمه جستجو فایل ها نمایش داده بشن و با زدن دکمه پاک همه فایل ها از روی هارد پاک بشن )
چهارم :چه طور 3 پروگرس بار رو به صورت مثلث در بیارم
پنج : چه طور برنامه ای بسازم که فرمت مثلا gif رو به icon تبدیل کنه
خواهشا کامل جواب بدید
ممنون