Application Bar Update - Browse Folders
Heres your chance to share your own tutorials with the community. Just post them on here. If your lucky they may even be posted on the main site.
5 posts
Page 1 of 1
Hello,
If you want to add the option to browse for files to add to the Icon Bar then first add a new option to the "ContextMenuStrip" control, I called it 'Browse' and then add this code in its click_event:
If you want to add the option to browse for files to add to the Icon Bar then first add a new option to the "ContextMenuStrip" control, I called it 'Browse' and then add this code in its click_event:
Code: Select all
Happy coding cooll; Dim browse As New OpenFileDialog
If browse.ShowDialog = Windows.Forms.DialogResult.OK Then
RichTextBox1.AppendText(browse.FileName + vbNewLine)
Dim w As New PictureBox
'**********************************************
Try
Dim shortcut, starget As String
Dim oshelllink
Dim wsh As Object = CreateObject("WScript.Shell")
wsh = CreateObject("WScript.Shell")
shortcut = browse.FileName
oshelllink = wsh.CreateShortcut(shortcut)
starget = oshelllink.TargetPath
'**********************************************
Using ico As Icon = Drawing.Icon.ExtractAssociatedIcon(starget)
Dim s = ico.ToBitmap
w.Image = s
End Using
Catch ex As Exception
Try
Using ico As Icon = Drawing.Icon.ExtractAssociatedIcon(browse.FileName)
Dim s = ico.ToBitmap
w.Image = s
End Using
Catch wex As Exception
If browse.FileName.Length = 4 Then
Using ico As Icon = My.Resources.Harddrive
Dim s = ico.ToBitmap
w.Image = s
End Using
End If
Using ico As Icon = My.Resources.Folder
Dim s = ico.ToBitmap
w.Image = s
End Using
End Try
End Try
If horv = "top" Then
w.Location = New Point(rowz, 5)
If numic > 4 Then
Me.Width += 40
End If
Me.CenterToScreen()
Me.Top = Screen.PrimaryScreen.Bounds.X
ElseIf horv = "left" Then
w.Location = New Point(5, rowz)
Me.Height += 40
' Me.Width -= 10
Me.CenterToScreen()
Me.Left = Screen.PrimaryScreen.Bounds.Y
ElseIf horv = "right" Then
w.Location = New Point(5, rowz)
Me.Height += 40
' Me.Width -= 10
Me.CenterToScreen()
Me.Left = Screen.PrimaryScreen.WorkingArea.Width + -Me.Width
ElseIf horv = "bottom" Then
w.Location = New Point(rowz, 5)
Me.Width += 40
Me.CenterToScreen()
'Me.Left = Screen.PrimaryScreen.Bounds.Width - Me.Width
' Me.Top = Screen.PrimaryScreen.Bounds.Height + -Me.Height
Me.Top = Screen.PrimaryScreen.WorkingArea.Height - Me.Height
End If
w.Size = New Size(30, 30)
w.Tag = browse.FileName
w.BackColor = Color.Transparent
AddHandler w.Click, AddressOf Fclick
AddHandler w.MouseEnter, AddressOf Lab_MouseEnter
AddHandler w.MouseLeave, AddressOf Lab_MouseLeave
Me.Controls.Add(w)
'Me.Width += 40
rowz += 40
numic += 1
Label2.Visible = False
saveme()
End If
Welcome to CodenStuff.com Learn Code, Love Code. Thank you for being a member of the community.
i updated it so its working
your one not working its has to be a folderbrowserdialog
your one not working its has to be a folderbrowserdialog
Code: Select all
Dim browse As New FolderBrowserDialog
If browse.ShowDialog = Windows.Forms.DialogResult.OK Then
RichTextBox1.AppendText(browse.SelectedPath + vbNewLine)
Dim w As New PictureBox
'**********************************************
Try
Dim shortcut, starget As String
Dim oshelllink
Dim wsh As Object = CreateObject("WScript.Shell")
wsh = CreateObject("WScript.Shell")
shortcut = browse.SelectedPath
oshelllink = wsh.CreateShortcut(shortcut)
starget = oshelllink.TargetPath
'**********************************************
Using ico As Icon = Drawing.Icon.ExtractAssociatedIcon(starget)
Dim s = ico.ToBitmap
w.Image = s
End Using
Catch ex As Exception
Try
Using ico As Icon = Drawing.Icon.ExtractAssociatedIcon(browse.SelectedPath)
Dim s = ico.ToBitmap
w.Image = s
End Using
Catch wex As Exception
If browse.SelectedPath.Length = 4 Then
Using ico As Icon = My.Resources.Harddrive
Dim s = ico.ToBitmap
w.Image = s
End Using
End If
Using ico As Icon = My.Resources.Folder
Dim s = ico.ToBitmap
w.Image = s
End Using
End Try
End Try
If horv = "top" Then
w.Location = New Point(rowz, 5)
If numic > 4 Then
Me.Width += 40
End If
Me.CenterToScreen()
Me.Top = Screen.PrimaryScreen.Bounds.X
ElseIf horv = "left" Then
w.Location = New Point(5, rowz)
Me.Height += 40
' Me.Width -= 10
Me.CenterToScreen()
Me.Left = Screen.PrimaryScreen.Bounds.Y
ElseIf horv = "right" Then
w.Location = New Point(5, rowz)
Me.Height += 40
' Me.Width -= 10
Me.CenterToScreen()
Me.Left = Screen.PrimaryScreen.WorkingArea.Width + -Me.Width
ElseIf horv = "bottom" Then
w.Location = New Point(rowz, 5)
Me.Width += 40
Me.CenterToScreen()
'Me.Left = Screen.PrimaryScreen.Bounds.Width - Me.Width
' Me.Top = Screen.PrimaryScreen.Bounds.Height + -Me.Height
Me.Top = Screen.PrimaryScreen.WorkingArea.Height - Me.Height
End If
w.Size = New Size(30, 30)
w.Tag = browse.SelectedPath
w.BackColor = Color.Transparent
AddHandler w.Click, AddressOf Fclick
AddHandler w.MouseEnter, AddressOf Lab_MouseEnter
AddHandler w.MouseLeave, AddressOf Lab_MouseLeave
Me.Controls.Add(w)
'Me.Width += 40
rowz += 40
numic += 1
Label2.Visible = False
saveme()
End If
CodeNStuff edit it with the latest version on the downloads and tutorial page too please becuz i m too lazy to code this again
now how would i make it work with this viewtopic.php?f=38&t=3544&p=24570#p24570
my updated version of yours
my updated version of yours
5 posts
Page 1 of 1
Copyright Information
Copyright © Codenstuff.com 2020 - 2023