Here presented for your delight is a wall of VB.NET code. These are code samples and fragments I have collected over a length of time, some of which have appeared in the Snippets section.
Initially, it lists code by the name of the Control it demonstrates but thereafter it loses some order. Personally, I search a keyword or control name to find what I'm looking for.
There are fairly limited comments as it wasn't intended for public perusal ;) although it should be self-documenting anyway.
Initially, it lists code by the name of the Control it demonstrates but thereafter it loses some order. Personally, I search a keyword or control name to find what I'm looking for.
There are fairly limited comments as it wasn't intended for public perusal ;) although it should be self-documenting anyway.
'VB.NET Code Samples CheckedListBox Control 'Toggle Checked/Unchecked CheckState For i As Integer = 0 To CheckedListBox1.Items.Count - 1 Dim state As CheckState = CheckedListBox1.GetItemCheckState(i) If state = CheckState.Checked Then state = CheckState.Unchecked Else state = CheckState.Checked End If CheckedListBox1.SetItemCheckState(i, state) Next 'ComboBox Control Private Sub ComboBox1_SelectedIndexChanged(sender As Object, e As EventArgs) _ Handles ComboBox1.SelectedIndexChanged MessageBox.Show("You selected " & ComboBox1.SelectedItem.ToString()) End Sub 'cf SelectionchangeCommitted: "Occurs when the user changes the selected item and that change is displayed in the ComboBox." 'Yes and No as 1 and 0: Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load ComboBox1.DataSource = {New With {.Choice = "No", .Represents = 0}, New With {.Choice = "Yes", .Represents = 1}} ComboBox1.DisplayMember = "Choice" ComboBox1.ValueMember = "Represents" End Sub Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click If ComboBox1.SelectedValue IsNot Nothing Then 'or just set DropDownStyle to DropDown MessageBox.Show(ComboBox1.SelectedValue.ToString()) End If End Sub ComboBox1.DataSource = {"Pears", "Bananas", "Grapes", "Apples"} ComboBox1.Items.AddRange({2000, 2001, 2002}) ComboBox1.Items.AddRange({Enumerable.Range(2000, 16).ToArray}) ComboBox1.DataSource = Enumerable.Range(2000, 16).ToList() 'a more complete example using DisplayMember and ValueMember, and SelectedItem Public Class Form1 Private _people As New List(Of Person) Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load _people.Add(New Person With {.FirstName = "Bob", .Age = 23, .NickName = "Bobby"}) _people.Add(New Person With {.FirstName = "Fred", .Age = 24, .NickName = "Freddy"}) cboPerson.DataSource = _people cboPerson.DisplayMember = "FirstName" cboPerson.ValueMember = "Age" End Sub Private Sub cboPerson_SelectionchangeCommitted(sender As Object, e As EventArgs) _ Handles cboPerson.SelectionchangeCommitted If cboPerson.SelectedIndex <> -1 Then 'MessageBox.Show(cboPerson.SelectedValue.ToString()) MessageBox.Show(CType(cboPerson.SelectedItem, Person).NickName) End If End Sub Class Person Property FirstName As String Property Age As Integer Property NickName As String End Class End Class 'Controls 'Looping through specific controls For Each tb As TextBox In Me.Controls.OfType(Of TextBox)(). _ Where(Function(x) x.Tag = "Something") Next 'Loop through ALL controls, recursive '(or could use GetNextControl, which uses the TabIndex) Sub AllControls(ByRef ctl As Control) For Each aCtl In ctl.Controls Debug.Print(aCtl.Name) If aCtl.HasChildren Then Call AllControls(aCtl) End If Next End Sub 'Check if any TextBoxes are empty Private Sub SetButton1() btnSubmit.Enabled = True Dim empties = Me.Controls.OfType(Of TextBox)().Where(Function(x) x.Text = "").Count() If empties > 0 Then btnSubmit.Enabled = False End If End Sub '.. or from an array of TextBoxes Dim texts() = {TextBox1, TextBox2, TextBox3} btnSubmit.Enabled = Not texts.Where(Function(x) x.Text = "").Any() 'or btnSubmit.Enabled = Not texts.Any(Function(x) x.Text = "") 'Checking controls in pairs (by similar name) Dim clipbd As String = "" For Each cb As CheckBox In Me.Controls.OfType(Of CheckBox)() If cb.Name.StartsWith("ckb") AndAlso cb.Checked Then Dim sTextName As String = cb.Name.Replace("ckb", "txt") Dim tb As TextBox = TryCast(Me.Controls(sTextName), TextBox) If Not tb Is Nothing AndAlso Not String.IsNullOrWhiteSpace(tb.Text) Then clipbd &= tb.Text & vbNewLine End If End If Next If Not String.IsNullOrWhiteSpace(clipbd) Then My.Computer.Clipboard.SetText(clipbd) End If 'DataGridView Control Private Sub ResetDataGridView() dataGridView1.CancelEdit() dataGridView1.Columns.Clear() dataGridView1.DataSource = Nothing End Sub 'Setting default value(s) Private Sub dgvFieldList_DefaultValuesNeeded(sender As Object, e As DataGridViewRowEventArgs) _ Handles dgvFieldList.DefaultValuesNeeded e.Row.Cells(1).Value = "System.String" End Sub 'change header style and color Private Sub frmExcel_Load(sender As Object, e As EventArgs) Handles MyBase.Load dgvExcel.EnableHeadersVisualStyles = False dgvExcel.ColumnHeadersDefaultCellStyle = New DataGridViewCellStyle With { .Font = New Font(dgvExcel.Font, FontStyle.Bold), .ForeColor = Color.Red } End Sub 'DataGridViewCheckBoxColumn 'toggle all other checkboxes in column Private Sub DataGridView1_CellContentClick(sender As Object, e As DataGridViewCellEventArgs) _ Handles DataGridView1.CellContentClick If e.ColumnIndex <> 0 Then 'better is 'If e.ColumnIndex <> DataGridView1.Columns("PK").Index Then Exit Sub 'it's not the checkbox End If 'how to store the NEW state of the checkbox Dim state = CType(DataGridView1.Rows(e.RowIndex).Cells(0).EditedFormattedValue, Boolean) For Each row As DataGridViewRow In DataGridView1.Rows If row.Index <> e.RowIndex Then row.Cells(0).Value = False End If Next End Sub 'Form Control MessageBox(Form.ActiveForm.Name) Public Class Form1 Private WithEvents frm2 As Form2 Private Sub Form1_FormClosed(sender As Object, e As FormClosedEventArgs) _ Handles Me.FormClosed My.Settings.Save() For Each frm As Form In Application.OpenForms frm.Close() Next Application.Exit() End Sub 'on a click event: frm2 = New Form2 'another way to add event handler AddHandler frm2.FormClosed, Sub(s, e2) doThis(s, e2) frm2.Show() Private Sub Form2_Closed(sender As Object, e As Windows.Forms.FormClosedEventArgs) _ Handles frm2.FormClosed Me.Close() End Sub 'Form Control - centre cursor Windows.Forms.Cursor.Position = New Point( _ Location.X + Me.Width / 2, Location.Y + Me.Height / 2) 'Form Control (Dialog) Relevant properties: FormBorderStyle, MinimizeBox, MaximizeBox, StartPosition, ShowInTaskbar, and DialogResult for buttons on the form. 'Form Control - MouseLeave Private Sub Form1_MouseLeave(sender As Object, e As EventArgs) Handles MyBase.MouseLeave Dim pt = PointToClient(Cursor.Position) If Not ClientRectangle.Contains(pt) Then 'mouse has left the form End If End Sub 'GetProperty - check if controls have a named property For Each ctl As Control In Me.ContextMenuStrip1.Controls If ctl.GetType().GetProperty("ForeColor") IsNot Nothing Then ctl.ForeColor = Color.Aquamarine End If Next 'Image - save and load image from MS Access OLE Object field Imports System.Data.OleDb Public Class Form1 Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click Dim connection As New OleDbConnection("Provider=Microsoft.ACE.OLEDB.12.0;" & _ "Data Source=C:\Users\Andrew\Documents\Pictures.accdb;" & _ "Persist Security Info=False;") Dim command As New OleDbCommand("INSERT INTO tblPictures (Picture, Description) VALUES (?, 'testing')", connection) Using picture As Image = Image.FromFile("C:\Users\Andrew\Pictures\coyote.jpg") Using stream As New IO.MemoryStream picture.Save(stream, Imaging.ImageFormat.Jpeg) command.Parameters.Add("Picture", OleDbType.VarBinary).Value = stream.GetBuffer() End Using End Using connection.Open() command.ExecuteNonQuery() connection.Close() End Sub Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click Dim connection As New OleDbConnection("Provider=Microsoft.ACE.OLEDB.12.0;" & _ "Data Source=C:\Users\Andrew\Documents\Pictures.accdb;" & _ "Persist Security Info=False;") Dim command As New OleDbCommand("SELECT Picture FROM tblPictures WHERE Description='testing'", connection) connection.Open() Dim pictureData As Byte() = DirectCast(command.ExecuteScalar(), Byte()) connection.Close() Dim picture As Image = Nothing 'Create a stream in memory containing the bytes that comprise the image. Using stream As New IO.MemoryStream(pictureData) 'Read the stream and create an Image object from the data. picture = Image.FromStream(stream) PictureBox1.Image = picture End Using End Sub End Class 'ListBox Control ListBox1.Items.AddRange({"Apples", "Pears", "Bananas"}) Private Sub ListBox1_SelectedIndexChanged(sender As Object, e As EventArgs) _ Handles ListBox1.SelectedIndexChanged Dim d As Integer ListBox2.BeginUpdate() For d = 0 To 4 ListBox2.Items.Add(ListBox1.Items(d).ToString()) Next d ListBox2.EndUpdate() End Sub If ListBox1.FindString("Apple") = -1 Then MessageBox.Show("Not found.") End If 'ListBox - some useful properties: PreferredHeight - the combined height of all items IntegralHeight - avoid showing partial items. 'ListBox - randomly remove items Private _rand As Random = New Random Dim iNext As Integer Label1.Text = "" For x As Integer = 1 To ListBox1.Items.Count iNext = _rand.Next(ListBox1.Items.Count) Label1.Text &= ListBox1.Items(iNext).ToString() & " " ListBox1.Items.RemoveAt(iNext) Next 'ListView Control MessageBox.Show(ListView1.FocusedItem.Text) Dim currentItem As Integer = ListView1.FocusedItem.Index MessageBox.Show(ListView1.SelectedItems.Item(0).Text) 'Adding an item - n.b. ListView1.View = Details Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click Dim newItem As New ListViewItem(TextBox1.Text) newItem.SubItems.Add(TextBox2.Text) newItem.SubItems.Add(TextBox3.Text) ListView1.Items.Add(newItem) 'also SubItems.AddRange End Sub 'MouseMove Event Private Sub Form1_MouseMove(ByVal sender As System.Object, _ ByVal e As System.Windows.Forms.MouseEventArgs) Handles MyBase.MouseMove 'PictureBox1.Location = PointToClient(Cursor.Position) 'The following code would need to be added to the picturebox's 'MouseMove event as well. Dim pt = PointToClient(Cursor.Position) pt.X = pt.X - PictureBox1.Width / 2 pt.Y = pt.Y - PictureBox1.Height / 2 PictureBox1.Location = pt End Sub 'NumericUpDown - up only Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load Dim uppity As New UpOnly uppity.Value = 5 uppity.ReadOnly = True 'cannot type number Me.Controls.Add(uppity) End Sub Public Class UpOnly : Inherits NumericUpDown Public Overrides Sub DownButton() Return 'don't do it! End Sub Public Overrides Sub UpButton() MyBase.UpButton() End Sub End Class 'Paint event/ drawing Public Class Form1 'class-level variable Private bDrawEllipse As Boolean = False Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load 'trigger Paint event when Form is resized Me.SetStyle(ControlStyles.ResizeRedraw, True) End Sub Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click Me.bDrawEllipse = Not Me.bDrawEllipse 'toggle the Ellipse Me.Refresh() 'immediately invalidate Form, triggering Paint event End Sub Private Sub Form1_Paint(sender As Object, e As PaintEventArgs) Handles MyBase.Paint If Not Me.bDrawEllipse Then 'don't re-draw the ellipse, it will just disappear Return End If Dim g As Graphics = e.Graphics 'get Graphics context g.FillEllipse(Brushes.DarkBlue, Me.ClientRectangle) End Sub End Class 'Paint event, re-draw Rectangle within Form's region (ClientSize) Public Class Form1 Private Sub Form1_Paint(sender As Object, e As PaintEventArgs) Handles MyBase.Paint Dim g = e.Graphics g.DrawRectangle(Pens.Red, New Rectangle(5, 5, _ Me.ClientRectangle.Width - 10, Me.ClientRectangle.Height - 10)) End Sub Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load Me.ResizeRedraw = True End Sub End Class 'PictureBox - move image 'It is preferable though, to ditch the PictureBox and just paint in a Panel 'or on the Form's surface. Public Class Form1 Private _moveIt As Boolean = False Private _coyote As Image Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load _coyote = PictureBox1.Image End Sub Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click _moveIt = True PictureBox1.Invalidate() End Sub Private Sub PictureBox1_Paint(sender As Object, e As PaintEventArgs) Handles PictureBox1.Paint If _moveIt = True Then PictureBox1.Image = Nothing e.Graphics.DrawImage(_coyote, New Rectangle(New Point(32, 64), _ New Size(_coyote.Width, _coyote.Height))) End If End Sub End Class 'PointToClient - detect if cursor inside form (client) rectangle Dim pt As Point = PointToClient(Cursor.Position) If ClientRectangle.Contains(pt) Then MessageBox.Show("Inside form..") End If 'RadioButton Control 'Using as a group - first place in a GroupBox and, possibly, 'within a Panel, if there are a set of (mutually exclusive) questions. Private m_Group1SelectedRadioButton As RadioButton Private Sub RadioButtonGroup1_CheckedChanged( _ ByVal sender As Object, ByVal e As EventArgs) Handles _ RadioButton1.CheckedChanged, RadioButton2.CheckedChanged, _ RadioButton3.CheckedChanged Dim SourceControl As RadioButton = DirectCast(sender, RadioButton) If SourceControl.Checked Then m_Group1SelectedRadioButton = SourceControl End If End Sub 'RichTextBox Control 'get the clicked line number Private Sub RichTextBox1_Click(sender As Object, e As EventArgs) _ Handles RichTextBox1.Click Dim clickedLine As Integer = 0 clickedLine = sender.GetLineFromCharIndex(sender.Selectionstart) MessageBox.Show(String.Format("You clicked line {0:d}", clickedLine)) End Sub 'add text at the end Me.RichTextBox1.Selectionstart = Me.RichTextBox1.TextLength Me.RichTextBox1.AppendText("some text") 'colour found words Dim reg As Regex = New Regex("\bhello\b", RegexOptions.Multiline Or RegexOptions.IgnoreCase) Dim rtb As RichTextBox = RichTextBox1 Dim mtchs As MatchCollection = reg.Matches(rtb.Text) 'Dim mat As Match = mtchs.Item(i) rtb.Invalidate() For Each m As Match In mtchs rtb.Selectionstart = m.Index rtb.SelectionLength = m.Length rtb.SelectionColor = Color.CadetBlue Next rtb.Update() 'copy and Paste formatted (rtf) text between RTBs Clipboard.SetText(RichTextBox1.Rtf, TextDataFormat.Rtf) RichTextBox2.Select(RichTextBox2.TextLength - 1, 1) 'RichTextBox2.ScrollToCaret() Dim myFormat As DataFormats.Format = DataFormats.GetFormat(DataFormats.Rtf) RichTextBox2.Paste(myFormat) 'merge the rtf of two RTBs, using a third RTB, and save Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click Dim rich As RichTextBox = New RichTextBox() rich.Rtf = RichTextBox1.Rtf rich.Selectionstart = rich.TextLength rich.SelectionLength = 0 rich.SelectedRtf = RichTextBox2.Rtf rich.SaveFile("C:\Users\Andrew\Documents\testrtf.docx", RichTextBoxStreamType.RichText) End Sub 'TableLayoutPanel Control 'on initializing, paint alternate rows Private Sub TableLayoutPanel1_CellPaint(sender As Object, e As _ TableLayoutCellPaintEventArgs) Handles TableLayoutPanel1.CellPaint If (e.Row = 0 Or e.Row = 2) Then Dim g As Graphics = e.Graphics Dim r As Rectangle = e.CellBounds g.FillRectangle(New SolidBrush(Color.Blue), r) End If End Sub 'TabControl Deselecting Event: e.Cancel = True to cancel the de-selection. Putting a Panel in a TabPage to hold all its controls, then setting Panel1.Enabled = False will disable all its child-controls. 'TabPage Control Dim newPage As TabPage For x = 1 To 4 newPage = New TabPage 'create new instance If x = 1 Then newPage.Text = "Repeat - 1" Else newPage.Text = x.ToString End If TabControl1.TabPages.Add(newPage) Next 'TextBox Control 'creating a new TextBox Dim tb As New TextBox With tb .Name = "txtNew1" .Text = "Hi new TextBox" .Location = New Point(10, 10) End With Me.Controls.Add(tb) 'select all with Ctrl-A, disabling Window's "ding" Protected Overrides Function ProcessCmdKey(ByRef msg As Message, keyData As Keys) As Boolean If TextBox1.Focused AndAlso keyData = (Keys.A Or Keys.Control) Then TextBox1.SelectAll() Return True End If Return MyBase.ProcessCmdKey(msg, keyData) End Function '************ USING SuppressKeyPress IS MUCH SIMPLER: Private Sub TextBox1_KeyDown(sender As Object, e As KeyEventArgs) Handles TextBox1.KeyDown If e.KeyCode = Keys.A AndAlso e.Modifiers = Keys.Control Then TextBox1.SelectAll() e.Handled = True e.SuppressKeyPress = True End If End Sub 'ToolTip Control ToolTip1.SetToolTip(TextBox1, "Hello textbox 1") 'TreeView populate with files and folders http://www.vbforums.com/showthread.php?512092-Show-folders-files-in-TreeView Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click Dim root As TreeNode = TreeView1.Nodes.Add("Documents") PopulateTreeView("c:\users\andrew\documents", root) End Sub Private Sub PopulateTreeView(ByVal dir As String, ByVal parentNode As TreeNode) Dim folder As String = String.Empty Try 'Add folders to treeview Dim folders() As String = IO.Directory.GetDirectories(dir) If folders.Length <> 0 Then Dim folderNode As TreeNode = Nothing Dim folderName As String = String.Empty For Each folder In folders folderName = IO.Path.GetFileName(folder) folderNode = parentNode.Nodes.Add(folderName) folderNode.Tag = folder PopulateTreeView(folder, folderNode) Next End If 'Add the files to treeview Dim files() As String = IO.Directory.GetFiles(dir) If files.Length <> 0 Then Dim fileNode As TreeNode = Nothing For Each file As String In files fileNode = parentNode.Nodes.Add(IO.Path.GetFileName(file)) fileNode.Tag = file Next End If Catch ex As UnauthorizedAccessException parentNode.Nodes.Add("Access Denied") End Try End Sub 'Validating Event Private Sub TextBox1_Validating(sender As Object, e As System.ComponentModel.CancelEventArgs) _ Handles TextBox1.Validating Dim tb = DirectCast(sender, TextBox) If Not "ABCD".Contains(tb.Text.ToUpper) Then MessageBox.Show("Not A,B,C or D.") e.Cancel = True End If End Sub 'WebBrowser Control WebBrowser1.Navigate("http://www.somepage.com") 'or WebBrowser1.Navigate(New Uri("http://www.somepage.com")) 'display from text-file (resource) or string WebBrowser1.DocumentText = My.Resources.TextFile1 WebBrowser1.DocumentText = "<html><body><h1>My email</h1></body></html>" 'clicking a button WebBrowser1.document.GetElementById("the_id").InvokeMember("click") 'to follow a hyperlink (an a-link) extract its href attribute 'and use WebBrowser.Navigate(href) 'adding text to an input element WebBrowser1.document.GetElementById("the_id").InnerText = "whatever.." 'search for elements Private Sub WebBrowser1_DocumentCompleted(sender As Object, e As _ WebBrowserDocumentCompletedEventArgs) Handles WebBrowser1.DocumentCompleted If WebBrowser1.Url.ToString.Contains("bbc") Then MessageBox.Show("The BBC!") End If 'looping through all a-links Dim addresses As String = "" Dim pageElements As HtmlElementCollection = WebBrowser1.document.GetElementsByTagName("A") 'or WebBrowser1.document.All For Each currElement As HtmlElement In pageElements addresses &= currElement.GetAttribute("href") & vbNewLine Next MessageBox.Show(addresses) End Sub 'search for element, not knowing id Dim elems As HtmlElementCollection 'if the ID is known: 'Dim elem As HtmlElement = WebBrowser1.document.GetElementById("someId") Dim doc = WebBrowser1.Document If doc IsNot Nothing Then 'the page is available.. '(use DocumentCompleted event in preference) End If elems = WebBrowser1.document.GetElementsByTagName("INPUT") Dim elem4 As HtmlElement = elems(3) 'the fourth input elem4.GetAttribute("name") Dim elem As HtmlElement = WebBrowser1.document.All.GetElementsByName("to")(0) elem.SetAttribute("value", "Hi there!") 'or 'combine GetElementsByName with GetELementsByTagName Dim elem As HtmlElement = WebBrowser1.document. _ GetElementsByTagName("input").GetElementsByName("to")(0) elem.SetAttribute("value", "Hi there!") 'remove an element Dim pageElements As HtmlElementCollection = WebBrowser1.document.GetElementsByTagName("input") For Each currElement As HtmlElement In pageElements If currElement.GetAttribute("type").ToLower = "submit" Then currElement.OuterHtml = "" End If Next 'Prevent opening of new window Private Sub WebBrowser1_NewWindow(sender As Object, e As System.ComponentModel.CancelEventArgs) _ Handles WebBrowser1.NewWindow WebBrowser1.Navigate(WebBrowser1.StatusText) e.Cancel = True End Sub 'Prevent pop-up on leaving page (untested) Private Sub WebBrowser1_DocumentCompleted(sender As Object, _ e As WebBrowserDocumentCompletedEventArgs) Handles WebBrowser1.DocumentCompleted Dim doc As HtmlDocument = WebBrowser1.Document Dim head As HtmlElement = doc.GetElementsByTagName("head")(0) Dim s As HtmlElement = doc.CreateElement("script") s.SetAttribute("text", "function cancelOut() { window.onbeforeunload = null; }") head.AppendChild(s) WebBrowser1.document.InvokeScript("cancelOut") End Sub 'Use WebBrowser to evaluate expression Imports System.Security.Permissions <PermissionSet(SecurityAction.Demand, Name:="FullTrust")> _ <System.Runtime.InteropServices.ComVisibleAttribute(True)> Public Class Form1 Dim browser As New WebBrowser Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load browser.ObjectForScripting = Me 'browser.ScriptErrorsSuppressed = True browser.DocumentText = "<script>function evalIt(x) { return eval(x); }</script>" End Sub Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click Dim result = browser.document.InvokeScript("evalIt", New String() {"3+4*5"}) If result IsNot Nothing Then MessageBox.Show(result.ToString()) '23 End If End Sub End Class ******************************************************* Array.FindIndex - to search an array of objects (using lambda) Dim people(9) As Person 'Person is the Class people(3).FirstName = "Bob" Dim idx = Array.FindIndex(people, Function(p As Person) p.FirstName = "Bob") Array.ConvertAll Dim myInt() = {1, 2, 5} myInt = Array.ConvertAll(myInt, Function(x) x + 100) For Each el In myInt Console.Write(el.ToString() & ", ") Next Bitwise Enumerations To change an attribute, use the following: to set an attribute, use Or to toggle an attribute, use Xor to turn off an attribute, use And Not to leave an attribute on but turn off all others, use And 'Clipboard Dim strClip As String = Clipboard.GetText() Dim strClipArray() = strClip.Split(Environment.NewLine) For Each line In strClipArray MessageBox.Show(line) Next 'ConnectionString (Access) Dim cn As New OleDb.OleDbConnection cn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _ & "C:\Users\Andrew\Documents\Staff Database.accdb;Jet OLEDB:Database Password=MyPassword;" cn.Open() 'csv, populate DataTable (allows random access) Imports System.Data.OleDb Dim sLocation = "C:\Users\Andrew\Documents\" Dim sConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sLocation & _ ";Extended Properties=""text;HDR=Yes;FMT=Delimited"";" Dim dt As New DataTable("employees") Using adapt As New OleDbDataAdapter("SELECT * FROM [Employees.csv]", sConn) adapt.Fill(dt) End Using Debug.Print(String.Join(",", dt.Rows(3).ItemArray())) '388991633,Katy,Abachiche,7269 Washington Blvd,Burlington,TX,etc.. For x As Integer = 3 To 10 Debug.Print("{0} {1}", dt.Rows(x)("FirstName"), dt.Rows(x)("City")) Next Dim cowboys = From duke In dt '.AsEnumerable() - not necessary Where duke("City") = "Dallas" And duke("Salary") > 40000 Order By duke("LastName") For Each dude In cowboys Debug.Print("{0} {1} {2}", dude("FirstName"), dude("LastName"), dude("Salary")) Next 'using a Data Reader instead of Data Adapter Dim dt As New DataTable("employees") Using conn As New OleDbConnection(sConn) Dim cmd As OleDbCommand = New OleDbCommand("SELECT * FROM [Employees.csv]", conn) If conn.State <> ConnectionState.Open Then conn.Open() End If Dim reader As OleDbDataReader = cmd.ExecuteReader(Commandbehavior.CloseConnection) dt.Load(reader) Debug.Print("There are {0} rows.", dt.Rows.Count) 'There are 2320 rows. End Using 'DataSource (DataGridView) 'Filter rows (not tested yet) Dim dt As New DataTable() dt = TryCast(DataGridView1.DataSource, DataTable) If dt IsNot Nothing Then dt.DefaultView.RowFilter = String.Format("Field_Name = '{0}'", Trim(TextBox1.Text)) End If 'to clear the filter: DefaultView.RowFilter = String.Empty 'DataTable, ColumnChanged Private _dt As DataTable = New DataTable("tblTest") Private _changed As Boolean = False Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load _dt.Columns.Add("Name", Type.GetType("System.String")) _dt.Columns.Add("Number1", Type.GetType("System.Int32")) _dt.Columns.Add("Number2", Type.GetType("System.Int32")) Dim row As DataRow = _dt.NewRow() row("Name") = "Bob" row("Number1") = 5 row("Number2") = 20 _dt.Rows.Add(row) _dt.AcceptChanges() Me.txtName.DataBindings.Add("Text", _dt, "Name", False, DataSourceUpdateMode.onpropertychanged) Me.nupFirst.DataBindings.Add("Value", _dt, "Number1", False, DataSourceUpdateMode.onpropertychanged) Me.nupSecond.DataBindings.Add("Value", _dt, "Number2", False, DataSourceUpdateMode.onpropertychanged) AddHandler _dt.ColumnChanged, AddressOf Column_Changed End Sub Private Sub Column_Changed(sender As Object, e As DataColumnChangeEventArgs) If Not _changed Then _changed = True MessageBox.Show("Something has changed..") RemoveHandler _dt.ColumnChanged, AddressOf Column_Changed End If End Sub 'DateTime Dim time As DateTime = DateTime.Parse("00:00:00.1334274") Console.Write(time.Millisecond.ToString) '133 'Directory MessageBox.Show(Directory.Exists("G:").ToString) 'Email Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click Dim mail As New MailMessage mail.To.Add("[email protected]") mail.From = New MailAddress("[email protected]") mail.Subject = "Just a test" mail.Body = "Hi there Andy!" Dim smtp As New SmtpClient("smtp.gmail.com", 587) With {.Credentials = New NetworkCredential("[email protected]", "Password1"), .EnableSsl = True} smtp.Send(mail) End Sub 'Enumerable 'Create alphabet Dim letts() As Char = Enumerable.Range(1, 26). Select(Function(x) Chr(x + 64)).ToArray For Each lett In letts Console.WriteLine(lett.ToString) Next 'Father/Son Update Dim sr As New StreamReader(filename) Dim sw As New StreamWriter(Path.ChangeExtension(filename, "tmp")) Dim buffer As String = sr.ReadLine() While buffer IsNot Nothing sw.WriteLine(buffer.Replace("foo", "bar")) buffer = sr.ReadLine() End While sr.Close() sw.Close() File.Copy(Path.ChangeExtension(filename, "tmp"), filename, True) File.Delete(Path.ChangeExtension(filename, "tmp")) 'Files, get total size based on extensions Dim info As DirectoryInfo = New DirectoryInfo("c:\users\andrew\documents") Dim search() As String = {".xlsx", ".docx"} 'Dim totalSize As Double = Aggregate file In info.EnumerateFiles("*.*") ' Where search.Contains(file.Extension.ToLower()) ' Into Sum(file.Length) 'Dim totalSize As Double = Aggregate file In info.EnumerateFiles("*.*").Where( ' Function(x) search.Contains(x.Extension.ToLower())) ' Into Sum(file.Length) Dim totalSize As Double = info.EnumerateFiles("*.*").Where( Function(x) search.Contains(x.Extension.ToLower())).Sum(Function(y) y.Length) Console.WriteLine("{0:N0} Bytes", {totalSize}) Console.WriteLine("{0:N2} KB", {totalSize / 1024}) Console.WriteLine("{0:N2} MB", {totalSize / (1024 * 1024)}) 'Files, get all files and subfolders (and their files) Imports System.IO Public Class Form1 Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click ListFilesAndFolders(TextBox1.Text) End Sub Private Sub ListFilesAndFolders(location As String) ListBox1.Items.Add(location) Try For Each sFile In Directory.GetFiles(location) ListBox1.Items.Add(sFile) Next Catch ex As UnauthorizedAccessException Debug.Print("Unauthorized file access") Catch ex As Exception 'ignore End Try For Each sPath In Directory.GetDirectories(location) Try ListFilesAndFolders(sPath) Catch ex As Exception Debug.Print(ex.Message) 'ignore, only iterating End Try Next End Sub End Class 'File.Copy 'Copy file with sequence number if Exists Imports System.IO Dim sOld As String = "C:\Users\Andrew\Documents\SampleText.txt" Dim sNew As String = "C:\Users\Andrew\Documents\ATextFile.txt" Dim sNewDir As String = Path.GetDirectoryName(sNew) & Path.DirectorySeparatorChar Dim sNewFile As String = Path.GetFileNameWithoutExtension(sNew) Dim sNewExtn As String = Path.GetExtension(sNew) Dim x As Integer = 0 If File.Exists(sNew) Then Do x = x + 1 sNew = sNewDir & sNewFile & CStr(x) & sNewExtn Loop While File.Exists(sNew) End If File.Copy(sOld, sNew) 'GetFiles of different extensions For Each f As String In Directory. _ GetFiles("C:\users\andrew\documents\", "*.*").Where(Function(x) Dim y = System.IO.Path.GetExtension(x) 'Return (y = ".txt" OrElse y = ".xlsx") Return (New String() {".doc", ".txt"}). Contains(y) End Function) Console.WriteLine(f) Next 'Folders, list subfolders with exclusions Dim excludes() As String = {"Visual", "Aptana"} GetDirs("C:\users\andrew\documents\") Private Sub GetDirs(path As String) For Each dr In Directory.EnumerateDirectories(path) Dim excludeIt As Boolean = False For Each excl As String In excludes If dr.Contains(excl) Then excludeIt = True Exit For End If Next If Not excludeIt Then Debug.Print(dr) GetDirs(dr) End If Next End Sub 'Handling Null Dim cmd As New SqlCommand cmd.Parameters.Add("cost", SqlDbType.Int) cmd.Parameters("cost").IsNullable = True cmd.Parameters("cost").Value = IIf(String.IsNullOrEmpty(TextBox1.Text), _ DBNull.Value, CInt(TextBox1.Text)) 'Icon Dim img As New System.Drawing.Icon("path to file") Me.Icon = img 'LINQ Examples Dim str4 = "Hi there and hello again end." Dim str5 = String.Join(" ", From s In str4.Split(" ") Select s Where s.Trim(" ").Length > 0) MessageBox.Show(str5) Dim letts As New Dictionary(Of Char, Integer) For x = 0 To 25 letts(Chr(65 + x)) = Int(Rnd() * 15) Next Dim top10 = (From x In letts Order By x.Value Descending Select x.Key, x.Value).Take(10) For Each x In top10 Debug.Print(x.Key & " " & x.Value) Next 'check string for 3 letters followed by 2 numbers Dim test As String = "abc12" Dim passed As Boolean = test.Length = 5 If passed Then passed = test.ToCharArray().Where(Function(x, ind) Return If(ind < 3, Char.IsLetter(x), Char.IsNumber(x)) End Function).Count() = 5 End If MessageBox.Show(passed) 'LINQ Group By and Sum ********************* Module Module1 'requires a textfile with 4 comma-separated columns Sub Main() Dim allEmployees = From line In System.IO.File.ReadLines("C:\users\andrew\documents\test.txt") Let Columns = line.Split(","c) Where Columns.Length = 4 Let empNum = Integer.Parse(Columns(0).Trim()) Let eCode = Columns(1) Let webCode = Columns(2) Let hrsWrk = Decimal.Parse(Columns(3)) Select New Employee With {.empNo = empNum, .eCode = eCode, .webCode = webCode, .hrsWork = hrsWrk} Dim EmpList As List(Of Employee) = allEmployees.ToList() Dim summary = From emp In EmpList Group emp By Key = New With {Key emp.empNo, Key emp.eCode, Key emp.webCode} Into Group Select New With {.num = Key.empNo, .code = Key.eCode, _ .web = Key.webCode, .total = Group.Sum(Function(x) x.hrsWork)} For Each item In summary Console.WriteLine("{0} {1} {2} {3}", item.num, item.code, item.web, item.total) Next Console.ReadKey() End Sub Public Class Employee Public Property empNo As Integer Public Property eCode As String Public Property webCode As String Public Property hrsWork As Decimal End Class End Module or ..... Dim summary = From emp In EmpList Group emp By Key = New With {Key emp.empNo, Key emp.eCode, Key emp.webCode} Into g = Group, s = Sum(emp.hrsWork) Select New With {.num = Key.empNo, .code = Key.eCode, _ .web = Key.webCode, .total = s} 'Group.Sum(Function(x) x.hrsWork)} ******************************************** 'ManagementObject(s) Dim objMOS As ManagementObjectSearcher Dim objMOC As Management.ManagementObjectCollection Dim objMO As Management.ManagementObject objMOS = New ManagementObjectSearcher("Select * From Win32_OperatingSystem") objMOC = objMOS.Get For Each objMO In objMOC Console.WriteLine(objMO("SerialNumber")) Next objMOS.Dispose() objMOS = Nothing objMO.Dispose() objMO = Nothing 'Path (System.IO) Dim chPath As Char = System.IO.Path.DirectorySeparatorChar Debug.Print(System.IO.Path.GetFileName("C:\users\blah.txt")) 'blah.txt Debug.Print(System.IO.Path.GetFileNameWithoutExtension("C:\users\blah.txt")) 'blah Debug.Print(System.IO.Path.GetFullPath("C:\users\blah.txt")) 'C:\users\blah.txt 'Regex Examples Dim str2 As String = "Hi there and hello again end." Dim r2 As New Regex("\s+") Dim str3 = r2.Replace(str2, " ", 1) MessageBox.Show(str3) Private Function FormatPhoneNumber(ByVal number As String) As String If number.Length <> 10 Then Return String.Empty 'not 10 characters End If Dim value As Long If Not Long.TryParse(number, value) Then Return String.Empty 'not all digits End If Dim pattern As String = "(\d{3})(\d{3})(\d{4})" Dim replacement As String = "($1) $2-$3" Dim formatted As String = New Regex(pattern).Replace(number, replacement) Return formatted End Function 'multiply numbers (by 2) Dim orig As String = "10 cup mayo, 2 tablespoons basil, and 3 cups ranch dressing" Dim pattern As String = "\b(\d)+\b" Dim evaluator As MatchEvaluator = AddressOf DoubleUp Dim result As String = Regex.Replace(orig, pattern, Function(x As Match) CStr(CInt(x.Value) * 2)) 'or .Replace(orig, pattern, evaluator) Console.WriteLine(result) '"20 cup mayo, 4 tablespoons basil, and 6 cups ranch dressing" Private Function DoubleUp(match As Match) As String Return CStr(CInt(match.Value) * 2) End Function 'Releasing COM Objects 'from CharlieMay @ DIC, 'also http://www.siddharthrout.com/2012/10/02/find-last-row-in-an-excel-sheetvbavb-net/ Private Sub ReleaseObject(ByVal obj As Object) Try System.Runtime.InteropServices.Marshal.FinalReleaseComObject(obj) obj = Nothing Catch ex As Exception obj = Nothing Finally GC.Collect() End Try End Sub 'Populating DataGridView from Excel data Imports Excel = Microsoft.Office.Interop.Excel 'Add Reference 'Microsoft Excel 14.0 Object Library Public Class frmExcel Private Sub btnNameRange_Click(sender As Object, e As EventArgs) Handles btnNameRange.Click Dim xlApp As New Excel.Application Dim xlBook As Excel.Workbook = xlApp.Workbooks.Open("C:\Users\Andrew\Documents\AndysData.xlsx") Dim xlSheet As Excel.Worksheet = xlBook.Worksheets(1) 'or use worksheet-name xlSheet.Range("A5").CurrentRegion.Name = "staffData" xlBook.Close(True) 'save changes ReleaseObject(xlSheet) ReleaseObject(xlBook) ReleaseObject(xlApp) End Sub Private Sub btnFillExcel_Click(sender As Object, e As EventArgs) Handles btnFillExcel.Click Dim sConn As String = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\Users\Andrew\Documents\AndysData.xlsx;" sConn &= "Extended Properties=""Excel 12.0 Xml;HDR=YES"";" Using conn As New OleDb.OleDbConnection(sConn) Dim dSet As New DataSet Dim adapt As New OleDb.OleDbDataAdapter("SELECT * FROM [staffData]", conn) adapt.Fill(dSet, "tblStaff") dgvExcel.DataSource = dSet.Tables("tblStaff") End Using End Sub Private Sub ReleaseObject(ByVal obj As Object) 'http://www.siddharthrout.com/2012/08/06/vb-net-two-dot-rule-when-working-with-office-applications-2/ Try System.Runtime.InteropServices.Marshal.ReleaseComObject(obj) obj = Nothing Catch ex As Exception obj = Nothing Finally GC.Collect() End Try End Sub End Class 'Settings (My) 'Assume sCol is already created in the Project Properties as a StringCollection My.Settings.sCol.Clear() 'clear everything My.Settings.sCol.Add("3456;Andy") My.Settings.sCol.Add("3000;Michael") My.Settings.sCol.Remove("1234;Pete") 'add the following to the FormClosed event: My.Settings.Save() 'SQL Parameters Private Sub btnGo_Click(sender As Object, e As EventArgs) Handles btnGo.Click Dim sConn As String = "Data Source=.\SQLExpress;Initial Catalog=northwind;Integrated Security=True" Dim sSql As String = "SELECT * FROM Orders WHERE ShipCountry = @Country AND OrderDate > @OrderDate" Dim conn As New SqlConnection(sConn) Dim cmd As New SqlCommand(sSql, conn) 'could configure parameters individually: cmd.Parameters.Add("@Country", SqlDbType.NVarChar) cmd.Parameters("@Country").Value = txtCountry.Text 'easier to add in one go, and let the database deal with the data-type: cmd.Parameters.AddWithValue("@OrderDate", dtpOrderDate.Value) Dim adapter As New SqlDataAdapter(cmd) Dim ds As New DataSet() adapter.Fill(ds, "OrdersTable") dgvData.DataSource = ds dgvData.DataMember = "OrdersTable" End Sub 'Structure Structure Country Dim Name As String Dim Abbreviation As String End Structure Dim Countries() As Country = {New Country With {.Name = "France", .Abbreviation = "FR"}} 'etc.. Dim sCountry As String = "France" 'get this text from TextBox.Text For Each item As Country In Countries If sCountry = item.Name Then 'found France in Array! End If Next 'Thread Thread.Sleep(500) 'TimeSpan 'Find hours difference Dim current As DateTime = DateTime.Now Dim prev As DateTime = DateTime.Parse("April 19, 2014") Dim diff As TimeSpan = current.Subtract(prev) Console.WriteLine("Diff in hours: {0}", diff.TotalHours) Console.ReadKey() 'Work Days Function Public Function AddWorkDays(ByVal dte As Date, ByVal x As Integer) As Date Dim a As Integer = If(x < 0, -1, 1) Dim weekend = {DayOfWeek.Saturday, DayOfWeek.Sunday} While x <> 0 Or weekend.Contains(dte.DayOfWeek) dte = dte.AddDays(a) x -= If(x = 0 Or weekend.Contains(dte.DayOfWeek), 0, a) End While Return dte End Function 'Data Source (simple - drag of details) Public Class Form1 Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load 'TODO: This line of code loads data into the 'SQLTrainingDataSet.customers' table. 'You can move, or remove it, as needed. Me.CustomersTableAdapter.Fill(Me.SQLTrainingDataSet.customers) End Sub Private Sub btnNext_Click(sender As Object, e As EventArgs) Handles btnNext.Click CustomersBindingSource.MoveNext() End Sub Private Sub btnPrev_Click(sender As Object, e As EventArgs) Handles btnPrev.Click CustomersBindingSource.MovePrevious() End Sub Private Sub btnUpdate_Click(sender As Object, e As EventArgs) Handles btnUpdate.Click CustomersBindingSource.EndEdit() SQLTrainingDataSet.GetChanges() CustomersTableAdapter.Update(SQLTrainingDataSet.customers) SQLTrainingDataSet.AcceptChanges() End Sub End Class 'Day of week - get following Monday For x As Integer = 0 To 30 Dim day = DateTime.Now.AddDays(x) dim mon = day.AddDays((7 - day.DayOfWeek + 1) Mod 7) If day.DayOfWeek = DayOfWeek.Monday Then mon = mon.AddDays(7) Debug.Print(day & " " & mon) Next x 'Check if connected to internet (tested from VBA) Private Declare Function InternetGetConnectedState Lib "wininet.dll" ( _ ByRef lpdwFlags As Long, ByVal dwReserved As Long) As Long Private Sub TestConn() Dim bConnected As Boolean bConnected = InternetGetConnectedState(0, 0) If bConnected Then MsgBox "Whe'hay, connected!" Else MsgBox "Doi, no connection!" End If End Sub 'XML as XDocument Sub Main() Dim theXml = <?xml version="1.0" encoding="utf-8"?> <MyData> <Items> <Item Name="Widget"> <Sub-Item>Yellow</Sub-Item> <Sub-Item>Orange</Sub-Item> </Item> <Item Name="Sprocket"> <Sub-Item>Red</Sub-Item> <Sub-Item>Blue</Sub-Item> <Sub-Item>Green</Sub-Item> </Item> </Items> </MyData> 'to create an XDocument from a file.. 'Dim theXml2 As New XDocument() 'theXml2 = Xdocument.Load("somefile.xml") For Each Item In theXml.Descendants("Item") Console.WriteLine(Item.Attribute("Name").Value) For Each subItem In Item.Elements("Sub-Item") Console.WriteLine(subItem.Value) Next Next 'prints Widget, Yellow, Orange, Sprocket, Red, Blue, Green Console.ReadKey() End Sub 'Check string for just digits Dim test As String = "1444" Dim outTest As UInteger If Not test.StartsWith("+") AndAlso UInteger.TryParse(test, outTest) Then MessageBox.Show("It's just digits!") End If
1 Comments On This Entry
Page 1 of 1
Page 1 of 1
Trackbacks for this entry [ Trackback URL ]
Tags
My Blog Links
Recent Entries
Recent Comments
Search My Blog
3 user(s) viewing
3 Guests
0 member(s)
0 anonymous member(s)
0 member(s)
0 anonymous member(s)