Готовые решения и полезные коды на Visual Basic .NET (Часть-1)

Public Class PopupControl
Private popup As New ToolStripDropDown()
Private host As New ToolStripControlHost(Me)
Sub New()
        popup.Margin = Padding.Empty
        popup.Padding = Padding.Empty
        host.Margin = Padding.Empty
        host.Padding = Padding.Empty
        popup.Items.Add(host)
        InitializeComponent()
End Sub
Public Sub ShowPopup(control As System.Windows.Forms.Control, point As System.Drawing.Point)
        popup.Show(control, point)
End Sub
End Class

Private Sub Label1_Click(sender As Object, e As EventArgs) Handles Label1.Click
Dim popup1 As New PopupControl
popup1.ShowPopup(sender, New Point(sender.Width, 0))
End Sub

Dim Element As Control = GetChildAtPoint(New Point("указываем координаты X", "указываем координаты Y"))
If Element Is Nothing Then
            ' нету объекта
Else
            ' есть объект
End If

''' <summary>
''' Получает GPS-координаты из метаданных файла JPEG
''' </summary>
''' <remarks></remarks>
Public Class GPSCoordinate
    Private sLat As String
    Private sLng As String
 
    Public Sub New(ByVal image As Bitmap)
        
        Dim gradLat, minLat, secLat As String
        Dim gradLng, minLng, secLng As String
        Dim ns As Integer = 1
        Dim ew As Integer = 1
        Dim strNS, strEW As String
 
        Try
            'Свойство 1 определяет полушарие "S"- южное, "N"- северное
            'Свойство 3 определяет стороны света : "W"- к западу от Гринвича, "E"- к востоку от Гринвича 
 
            strNS = Encoding.Default.GetString(image.GetPropertyItem(1).Value)
            strEW = Encoding.Default.GetString(image.GetPropertyItem(3).Value)
 
            If strNS = "S" Then
                ns = -1    'Южное полушарие
            End If
 
            If strEW = "W" Then
                ew = -1     'К западу от Гринвича
            End If
 
            gradLat = image.GetPropertyItem(2).Value(0).ToString 'Целые градусы широты (нулевой байт)
            minLat = image.GetPropertyItem(2).Value(8).ToString  'Целые минуты широты (восьмой байт)
 
            'С секундами сложнее, разные камеры дают разное количество байтов
            'Этот алгоритм создан эмпирическим путем т.к. не нашел стандарта
            'Точность 5-6 знаков после запятой в сравнении со штатным декодером аппарата
 
            With image.GetPropertyItem(2) 'Секунды широты
                If .Value(17) = 0 Then
                    secLat = BitConverter.ToUInt16({.Value(16), .Value(17)}, 0)
                Else
                    secLat = (BitConverter.ToUInt32({.Value(16), .Value(17), .Value(18), .Value(19)}, 0)) / 1000
                End If
            End With
 
            'Широта в десятичном представлении с учетом полушария
            sLat = ((CSng(gradLat) + CSng(minLat) / 60 + CSng(secLat) / 3600) * ns).ToString.Replace(",", ".")
 
            gradLng = image.GetPropertyItem(4).Value(0).ToString  'Целые градусы долготы (нулевой байт)
            minLng = image.GetPropertyItem(4).Value(8).ToString   'Целые минуты долготы (восьмой  байт)
 
            With image.GetPropertyItem(4)  'Секунды долготы
                If .Value(17) = 0 Then
                    secLng = BitConverter.ToUInt16({.Value(16), .Value(17)}, 0)
                Else
                    secLng = (BitConverter.ToUInt32({.Value(16), .Value(17), .Value(18), .Value(19)}, 0)) / 1000
                End If
            End With
 
            'Долгота в десятичном представлении с учетом стороны света
            sLng = ((CSng(gradLng) + CSng(minLng) / 60 + CSng(secLng) / 3600) * ew).ToString.Replace(",", ".")
 
        Catch ex As Exception
            sLat = "0"
            sLng = "0"
        End Try
        
    End Sub
    ''' <summary>
    ''' Десятичное значение широты GPS-координаты
    ''' </summary>
    ''' <value></value>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public ReadOnly Property Lat() As String
        Get
            Return sLat
        End Get
    End Property
    ''' <summary>
    ''' Десятичное значение долготы GPS-координаты 
    ''' </summary>
    ''' <value></value>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public ReadOnly Property Lng() As String
        Get
            Return sLng
        End Get
    End Property
 
End Class

Public Class Form1
    Declare Function GetAsyncKeyState Lib "user32" (key As System.Windows.Forms.Keys) As Short
 
    Private Sub TimerKey_Tick(sender As Object, e As EventArgs) Handles TimerKey.Tick
        Select Case Control.ModifierKeys
            Case Keys.Control
                If GetAsyncKeyState(Keys.F1) Then
                    MsgBox("Привет " & Environment.UserName & "!")
                End If
        End Select
    End Sub
 
    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        TimerKey.Start()
    End Sub
End Class

WebBrowser1.Navigate("http://mail.ru/")
 
While WebBrowser1.Document Is Nothing
    Application.DoEvents()
End While
While WebBrowser1.Document.Body Is Nothing
    Application.DoEvents()
End While

Imports mshtml
...
Private HtmlDoc2 As IHTMLDocument2
...
' в DocumentCompleted или не раньше, чем после первого цикла из трюка 1!
HtmlDoc2 = DirectCast(WebBrowser1.Document.DomDocument, IHTMLDocument2)
HtmlDoc2.designMode = "on" ' обратно - "off"

' в DocumentCompleted или после второго цикла из трюка 1!
WebBrowser1.Document.Body.Focus()

'кнопка
HtmlDoc2.execCommand("InsertButton", False, Nothing)
'картинка
HtmlDoc2.execCommand("InsertImage", True, Nothing)
'ссылка
HtmlDoc2.execCommand("CreateLink", True, Nothing)

HtmlDoc2.execCommand("CreateLink", False, "URL")

Dim img As HtmlElement = WebBrowser1.Document.CreateElement("img")
img.SetAttribute("src", "путь к картинке")
WebBrowser1.Document.Body.AppendChild(img)

Dim DbEng = New DAO.DBEngine()

'файл DataBase1.mdb лежит в папке с exe
Dim Db As DAO.Database = DbEng.OpenDatabase(Application.StartupPath & "\Database1.mdb")

Dim Rs As DAO.Recordset = Db.OpenRecordset("Таблица1")

Rs.Fields("номер столбца с нуля").Value

Rs.AddNew()
Rs.Update()

Rs.MoveFirst()
Rs.Move(номер строки с нуля)
 
Rs.Delete()

Rs.MoveFirst()
Rs.Move(номер строки с нуля)
 
Rs.Edit()
Rs.Fields(номер столбца с нуля).Value = "значение"
Rs.Update()

Db.Execute

Imports iTextSharp.text
Imports iTextSharp.text.pdf
Imports System.IO
 
Public Class Form1
 
    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        ' получаем имена всех файлов с расширением jpg
        Dim ArrImg() As String
        ArrImg = Directory.GetFiles("C:\Temp", "*.jpg", SearchOption.TopDirectoryOnly)
        If ArrImg.Length < 1 Then
            MessageBox.Show("Файлы изображений в указанной папке не найдены. Проверьте существование изображений в указанной папке.", "Внимание !!!!", MessageBoxButtons.OK, MessageBoxIcon.Error)
            Exit Sub
        End If
        Dim oImage As Bitmap
        For i As Integer = 0 To UBound(ArrImg)
            oImage = New Bitmap(ArrImg(i)) ' получаем картинку
 
            ' имя pdf-файла получаем из имени изображения
            Dim oPdfFileName As String = Replace(Path.GetFullPath(ArrImg(i)), Path.GetExtension(ArrImg(i)), ".pdf")
 
            ' создаем новый документ. размер страницы вычисляем по размеру изображения
            Dim doc As New Document(New Rectangle(oImage.Width * 72 / oImage.HorizontalResolution, oImage.Height * 72 / oImage.VerticalResolution))
 
            Try
                PdfWriter.GetInstance(doc, New FileStream(oPdfFileName, FileMode.Create))
                doc.Open()
                Dim oIMG As Image = Image.GetInstance(ArrImg(i))
                oIMG.ScaleToFit(doc.PageSize)
                oIMG.SetAbsolutePosition(0, 0)
                doc.Add(oIMG)
            Catch ex As Exception
            Finally
                doc.Close()
            End Try
 
            Me.Close()
        Next i
    End Sub
End Class

Public Class Form1
    Inherits Form
    Private bar1 As New VerticalProgressBar()
    Private button1 As New Button()
 
    <STAThread()> _
    Public Shared Sub Main()
        ' The call to EnableVisualStyles below does not affect
        ' whether ProgressBarRenderer.IsSupported is true; as 
        ' long as visual styles are enabled by the operating system, 
        ' IsSupported is true.
        Application.EnableVisualStyles()
        Application.Run(New Form1())
 
    End Sub 'Main
    ' Start the VerticalProgressBar.
    Private Sub button1_Click(ByVal sender As Object, ByVal e As EventArgs)
        bar1.Start()
 
    End Sub 'button1_Click
 
    Private Sub InitializeComponent()
        Me.SuspendLayout()
        '
        'Form1
        '
        Me.ClientSize = New System.Drawing.Size(692, 433)
        Me.Name = "Form1"
        Me.ResumeLayout(False)
 
        Me.Size = New Size(500, 500)
        bar1.NumberChunks = 30
        button1.Location = New Point(150, 10)
        button1.Size = New Size(150, 30)
        button1.Text = "Start VerticalProgressBar"
        AddHandler button1.Click, AddressOf button1_Click
        Controls.AddRange(New Control() {button1, bar1})
    End Sub
End Class 'Form1
 
 
Public Class VerticalProgressBar
    Inherits Control
    Private numberChunksValue As Integer
    Private ticks As Integer
    Private progressTimer As New Timer()
    Private progressBarRectangles() As Rectangle
 
 
    Public Sub New()
        Me.Location = New Point(10, 10)
        Me.Width = 50
 
        ' The progress bar will update every second.
        progressTimer.Interval = 1000
        AddHandler progressTimer.Tick, AddressOf progressTimer_Tick
 
        ' This property also calls SetupProgressBar to initialize 
        ' the progress bar rectangles if styles are enabled.
        NumberChunks = 20
 
        ' Set the default height if visual styles are not enabled.
        If Not ProgressBarRenderer.IsSupported Then
            Me.Height = 100
        End If
 
    End Sub 'New
 
    ' Specify the number of progress bar chunks to base the height on.
 
    Public Property NumberChunks() As Integer
        Get
            Return numberChunksValue
        End Get
 
        Set(ByVal value As Integer)
            If value <= 50 AndAlso value > 0 Then
                numberChunksValue = value
            Else
                MessageBox.Show("Number of chunks must be between " + "0 and 50; defaulting to 10")
                numberChunksValue = 10
            End If
 
            ' Recalculate the progress bar size, if visual styles 
            ' are active.
            If ProgressBarRenderer.IsSupported Then
                SetupProgressBar()
            End If
        End Set
    End Property
 
 
    ' Draw the progress bar in its normal state.
    Protected Overrides Sub OnPaint(ByVal e As PaintEventArgs)
        MyBase.OnPaint(e)
 
        If ProgressBarRenderer.IsSupported Then
            ProgressBarRenderer.DrawVerticalBar(e.Graphics, ClientRectangle)
            Me.Parent.Text = "VerticalProgressBar Enabled"
        Else
            Me.Parent.Text = "VerticalProgressBar Disabled"
        End If
 
    End Sub 'OnPaint
 
    ' Initialize the rectangles used to paint the states of the 
    ' progress bar.
    Private Sub SetupProgressBar()
        If Not ProgressBarRenderer.IsSupported Then
            Return
        End If
 
        ' Determine the size of the progress bar frame.
        Me.Size = New Size(ClientRectangle.Width, NumberChunks * (ProgressBarRenderer.ChunkThickness + 2 * ProgressBarRenderer.ChunkSpaceThickness) + 6)
 
        ' Initialize the rectangles to draw each step of the 
        ' progress bar.
        progressBarRectangles = New Rectangle(NumberChunks) {}
 
        Dim i As Integer
        For i = 0 To NumberChunks
            ' Use the thickness defined by the current visual style 
            ' to calculate the height of each rectangle. The size 
            ' adjustments ensure that the chunks do not paint over 
            ' the frame.
            Dim filledRectangleHeight As Integer = (i + 1) _
  * (ProgressBarRenderer.ChunkThickness + 2 * ProgressBarRenderer.ChunkSpaceThickness)
 
            progressBarRectangles(i) = New Rectangle(ClientRectangle.X + 3, _
                ClientRectangle.Y + ClientRectangle.Height - 3 - filledRectangleHeight, _
                ClientRectangle.Width - 6, filledRectangleHeight)
        Next i
 
    End Sub 'SetupProgressBar
 
    ' Handle the timer tick; draw each progressively larger rectangle.
    Private Sub progressTimer_Tick(ByVal myObject As [Object], ByVal e As EventArgs)
        If ticks < NumberChunks Then
            Dim g As Graphics = Me.CreateGraphics()
            Try
                ProgressBarRenderer.DrawVerticalChunks(g, progressBarRectangles(ticks))
                ticks += 1
            Finally
                g.Dispose()
            End Try
        Else
            progressTimer.Enabled = False
        End If
 
    End Sub 'progressTimer_Tick
 
    ' Start the progress bar.
    Public Sub Start()
        If ProgressBarRenderer.IsSupported Then
            progressTimer.Start()
        Else
            MessageBox.Show("VerticalScrollBar requires visual styles")
        End If
 
    End Sub 'Start
 
End Class

 ' Dim wd As Word.Application
' Import Word = Microsoft.Office.Interop.Word
wd = New Word.Application()

document = wd.Documents.Add(...)

wd.CommandBars.AdaptiveMenus = False
.......
wd.ActiveWindow.DisplayRightRuler = False
wd.ActiveWindow.DisplayScreenTips = False
wd.ActiveWindow.DisplayVerticalRuler = False
wd.ActiveWindow.DisplayRightRuler = False
wd.ActiveWindow.ActivePane.DisplayRulers = False
wd.ActiveWindow.ActivePane.View.Type = Word.WdViewType.wdWebView

Dim hWnd As Long
hWnd = FindWindow(vbNullString, "Калькулятор")
ShowWindow(hWnd, SW_MAXIMIZE)

Dim hWnd As Long
hWnd = FindWindow("имя оконного класса", vbNullString)
ShowWindow(hWnd, SW_MAXIMIZE)

    Public Function SetOpacityImage(image As System.Drawing.Image, t As Single) As Image
        Dim resultImage As New System.Drawing.Bitmap(image.Width, image.Height)
        Dim Graphics As System.Drawing.Graphics = System.Drawing.Graphics.FromImage(resultImage)
        Dim ImageAttributes As New System.Drawing.Imaging.ImageAttributes
        ImageAttributes.SetColorMatrix(New System.Drawing.Imaging.ColorMatrix() With {.Matrix33 = t})
        Graphics.DrawImage(image, New Rectangle(0, 0, image.Width, image.Height), 0, 0, image.Width, image.Height, GraphicsUnit.Pixel, ImageAttributes)
        Graphics.Save() : Graphics.Dispose()
        Return resultImage
    End Function