It works fine until I click it and pop up a file dialog box,and then white lines appears surrounding it.
I don't know how to remove these ugly lines.
The only code is openFileDialog1.ShowDialog().
It's a Button whose FlatStyle is flat and whose BackgroundImage is a PNG image.
After that the white lines appears, and if I click the Form it will disappear.
A simple workaround is to set the Button FlatAppearance.BorderColor to its Parent.BackColor. It will overwrite the focus rectangle. The MouseUp event can be used to set the value, it will be raised before a new Window is opened (the Control.Leave event will never be raised):
Private Sub SomeButton_MouseUp(sender As Object, e As MouseEventArgs) Handles SomeButton.MouseUp
Dim ctl As Button = DirectCast(sender, Button)
ctl.FlatAppearance.BorderColor = ctl.Parent.BackColor
End Sub
Using the Control.Paint event, we can also use the Control.BackColor property to paint the border, both with the ControlPaint class DrawBorder method (simpler than using the ButtonRenderer class):
Private Sub SomeButton_Paint(sender As Object, e As PaintEventArgs) Handles SomeButton.Paint
Dim ctl As Button = DirectCast(sender, Button)
ControlPaint.DrawBorder(e.Graphics, ctl.ClientRectangle, ctl.BackColor, ButtonBorderStyle.Solid)
End Sub
and painting the Control's border ourselves:
(Note that the ClientRectangle size must be shrinked, by 1 pixel, both in the Width and Height dimensions. This is by design).
Private Sub SomeButton_Paint(sender As Object, e As PaintEventArgs) Handles SomeButton.Paint
Dim ctl As Control = DirectCast(sender, Control)
Dim r As Rectangle = ctl.ClientRectangle
Using pen As Pen = New Pen(ctl.BackColor, 1)
e.Graphics.DrawRectangle(pen, r.X, r.Y, r.Width - 1, r.Height - 1)
End Using
End Sub
Related
I want to do something seemingly simple - programmatically select and highlight a row of a ListView in VB.NET.
VB.NET: How to dynamically select a list view item?
tells me what should to be all that is needed, but it isn't. The row is selected, but not highlighted.
http://vbcity.com/forums/t/28260.aspx
tells me about the "HideSelection" property and the .Focus() method (also referenced at Select programmatically a row of a Listview), which sounded hopeful, but the best I can get is the faint highlight mentioned, I want the full monty. I tried a Noddy example with just a ListView, in Details mode, FullRowSelection = true, HideSelection = False, one columnheader defined and then
ListView1.Items.Add("Red")
ListView1.Items.Add("Orange")
ListView1.Items.Add("Yellow")
ListView1.Items.Add("Green")
ListView1.Items(2).Selected = True
I get this
but I want this
I can simulate highlighting by adding these lines
ListView1.SelectedItems(0).BackColor = Color.CornflowerBlue
ListView1.SelectedItems(0).ForeColor = Color.White
but then how can I be sure to undo the artificial highlight if the row can be implicitly as well as explicitly deselected? Do I have to think of all the possible cases? That's too much work for what should be a simple operation. Plus, since I want to color-code my rows, there is an additional challenge that when I undo the highlight color, I have to figure out what color is appropriate at that point. Is there a better, simpler way?
You can access the Graphics object used to draw each item, and draw them yourself.
Make a new project with a Button and ListView. Paste the following code:
Form_Load to use multiple subitems
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Me.ListView1.OwnerDraw = True ' or else can't handle DrawItem event
ListView1.Columns.Add("ColumnHeader1")
ListView1.Columns.Add("ColumnHeader2")
ListView1.Columns.Add("ColumnHeader3")
Me.ListView1.Items.Add("Red")
Me.ListView1.Items.Add("Orange")
Me.ListView1.Items.Add("Yellow")
Me.ListView1.Items.Add("Green")
ListView1.Items(0).SubItems.Add("Strawberry")
ListView1.Items(0).SubItems.Add("Apple")
ListView1.Items(1).SubItems.Add("Pepper")
ListView1.Items(1).SubItems.Add("Apricot")
ListView1.Items(2).SubItems.Add("Plum")
ListView1.Items(2).SubItems.Add("Banana")
ListView1.Items(3).SubItems.Add("Apple")
ListView1.Items(3).SubItems.Add("Lime")
End Sub
Three handlers for the ListView's drawing related events. Code copied from this answer
Private Sub listView1_DrawColumnHeader(sender As Object, e As DrawListViewColumnHeaderEventArgs) Handles ListView1.DrawColumnHeader
e.DrawDefault = True
End Sub
Private Sub listView1_DrawSubItem(sender As Object, e As DrawListViewSubItemEventArgs) Handles ListView1.DrawSubItem
Const TEXT_OFFSET As Integer = 1
' I don't know why the text is located at 1px to the right. Maybe it's only for me.
Dim listView As ListView = DirectCast(sender, ListView)
' Check if e.Item is selected and the ListView has a focus.
If Not listView.Focused AndAlso e.Item.Selected Then
Dim rowBounds As Rectangle = e.SubItem.Bounds
Dim labelBounds As Rectangle = e.Item.GetBounds(ItemBoundsPortion.Label)
Dim leftMargin As Integer = labelBounds.Left - TEXT_OFFSET
Dim bounds As New Rectangle(rowBounds.Left + leftMargin, rowBounds.Top, If(e.ColumnIndex = 0, labelBounds.Width, (rowBounds.Width - leftMargin - TEXT_OFFSET)), rowBounds.Height)
Dim align As TextFormatFlags
Select Case listView.Columns(e.ColumnIndex).TextAlign
Case HorizontalAlignment.Right
align = TextFormatFlags.Right
Exit Select
Case HorizontalAlignment.Center
align = TextFormatFlags.HorizontalCenter
Exit Select
Case Else
align = TextFormatFlags.Left
Exit Select
End Select
TextRenderer.DrawText(e.Graphics, e.SubItem.Text, listView.Font, bounds, SystemColors.HighlightText, align Or TextFormatFlags.SingleLine Or TextFormatFlags.GlyphOverhangPadding Or TextFormatFlags.VerticalCenter Or TextFormatFlags.WordEllipsis)
Else
e.DrawDefault = True
End If
End Sub
Private Sub listView1_DrawItem(sender As Object, e As DrawListViewItemEventArgs) Handles ListView1.DrawItem
Dim listView As ListView = DirectCast(sender, ListView)
' Check if e.Item is selected and the ListView has a focus.
If Not listView.Focused AndAlso e.Item.Selected Then
Dim rowBounds As Rectangle = e.Bounds
Dim leftMargin As Integer = e.Item.GetBounds(ItemBoundsPortion.Label).Left
Dim bounds As New Rectangle(leftMargin, rowBounds.Top, rowBounds.Width - leftMargin, rowBounds.Height)
e.Graphics.FillRectangle(SystemBrushes.Highlight, bounds)
Else
e.DrawDefault = True
End If
End Sub
Button click handler to simulate item(2) selected
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Me.ListView1.Items(2).Selected = True
End Sub
This will draw the background color regardless of focus. You have a lot of control over other colors and fonts going this route too.
Here, the button has been clicked, to select item 2, while the button still has focus, and item 2 is selected.
Easiest thing,
Just allocate the LST_ItemIndex = lstList.FocusedItem.Index everytime you select a different item
and then fire the below whenever you want the highlight
If lstList.Items.Count > 0 Then
lstList.Items(LST_ItemIndex).Selected = True
lstList.Items(LST_ItemIndex).EnsureVisible()
End If
I am new to VB and just can't figure it out how to animate a button using the MouseHover Event..
I want to create a single loop for all the buttons(picturebox) in my project that will increase the button's size when the user rests the mouse on it.
Maybe something like:
For Each Form As Form In Application.OpenForms
For Each Control As Control In Form.Controls
Tks. Any help is appreciated.
Use Inherits to create a new button (or PictureBox) class for you purpose. Here is the code.
Public Class cuteButton
Inherits System.Windows.Forms.Button
Protected Overrides Sub OnMouseHover(e As EventArgs)
'
'Wite code here to change button size or whatever.
'
MyBase.OnMouseHover(e)
End Sub
End Class
A very simple way is to use a common MouseHover event to grow your buttons (which I guess is really a Picturebox with an image in it):
Private Sub CustomButton_Grow(sender As Object, e As System.EventArgs) Handles Picturebox1.MouseHover, Picturebox2.MouseHover
'Set a maximum height to grow the buttons to.
'This can also be set for width depending on your needs!
Dim maxHeight as single = 50
If sender.Height < maxHeight then
sender.Size = New Size(sender.Width+1,sender.Height+1)
End if
End Sub
Then you can reset all buttons in a snap using the MouseLeave event. If you want that part animated as well then you can to use a global shrink routine that constantly shrink all buttons but the one in MouseHover. Good luck!
This Will Work even if you have 10,000 button or picture box ....
I am Assuming that you only have 1 form and many Buttons ,,, you have to be specific on your question
This Code will work fine with Buttons, Picturebox ,text box
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
For Each cntrl As Control In Controls ' Looping for each Button as Control
If TypeOf cntrl Is Button Then
AddHandler cntrl.MouseEnter, AddressOf cntrl_MouseEnter ' Adding the event and handler
AddHandler cntrl.MouseLeave, AddressOf cntrl_MouseLeave ' Adding the event and handler
End If
Next
End Sub
'' Assuming you wanna eNlarge everytime the mouse Hover or Enter
Private Sub cntrl_MouseEnter(sender As Object, e As EventArgs)
CType(sender, Button).Size = New Point(CType(sender, Button).Size.Width + 50, CType(sender, Button).Size.Height + 50)
End Sub
'' Here it goes back normal size
Private Sub cntrl_MouseLeave(sender As Object, e As EventArgs)
CType(sender, Button).Size = New Point(CType(sender, Button).Size.Width - 50, CType(sender, Button).Size.Height - 50)
End Sub
I have a Picture Box called BGImage. I hope that when the user clicks on this I can capture the position of the mouse relative to BGImage.
I've tried using MousePosition, only to find it gives the mouse location on the screen, not on the PictureBox.
So I also tried using PointToClient:
Dim MousePos As Point = Me.PointToClient(MousePosition)
But this gives me the location {X=1866,Y=55} whereas I actually clicked on the PictureBox at around {X=516,Y=284}.
I think the problem arises because I have full-screened my program and set the position of the PictureBox to be at the centre of the screen (BGImage.Location = New Point((My.Computer.Screen.WorkingArea.Width / 2) - (1008 / 2), ((My.Computer.Screen.WorkingArea.Height / 2) - (567 / 2))))
I should also mention that the size of the PictureBox is 1008 By 567 pixels and my screen resolution is 1366 by 768.
Is there any way I can get the mouse position relative to BGImage's position?
Add a mouse click event to your picture box
Then use the MouseEventArgs to get the mouse position inside the picture box.
This will give you the X and the Y location inside the picture box.
Dim PPoint As Point
Private Sub PictureBox1_MouseClick(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseClick
PPoint = New Point(e.X, e.Y)
MsgBox(Convert.ToString(PPoint))
End Sub
I have before the same problem and just solved with the help of some friends.
Give a look Here mouse position is not correct
Here its the code that give you the correct position of the Mouse Based On A Picture.
Tanks to #Aaron he have give a final solution to this problem.
This will put a red dot on the exact point you click. I wonder how useful setting the cursor position will be though, as they will almost certainly move the mouse after clicking the button (inadvertently or not).
Setting the Cursor position needs to be in Screen coordinates - this converts back to client coordinates for drawing. I don't believe the PointToClient is necessary for the cursor position. In the below code, it is an unnecessary conversion, as you just go back to client coordinates. I left it in to show an example of each conversion, so that you can experiment with them.
Public Class Form1
Private PPoint As Point
Public Sub New()
' This call is required by the designer.
InitializeComponent()
PictureBox1.BackColor = Color.White
PictureBox1.BorderStyle = BorderStyle.Fixed3D
AddHandler PictureBox1.MouseClick, AddressOf PictureBox1_MouseClick
AddHandler Button8.Click, AddressOf Button8_Click
' Add any initialization after the InitializeComponent() call.
End Sub
Private Sub Button8_Click(sender As Object, e As EventArgs)
Dim g As Graphics = PictureBox1.CreateGraphics()
Dim rect As New Rectangle(PictureBox1.PointToClient(PPoint), New Size(1, 1))
g.DrawRectangle(Pens.Red, rect)
End Sub
Private Sub PictureBox1_MouseClick(sender As Object, e As MouseEventArgs)
PPoint = PictureBox1.PointToScreen(New Point(e.X, e.Y))
Label8.Text = PPoint.X.ToString()
Label9.Text = PPoint.Y.ToString()
End Sub
End Class
Instead of using:
Dim MousePos As Point = Me.PointToClient(MousePosition)
You should be using:
Dim MousePos As Point = BGImage.PointToClient(MousePosition)
It will give you mouse position in BGImage coordinates, whereas the first code gives you the mouse position in the Form's coordinates.
I have code to drag files into a textbox, but I would also like to have code to drag the file out of the textbox, thus clearing it.
Anybody have any ideas?
You can use the DoDragDrop method to do a drag & drop operation. It returns a DragDropEffects value that specifies if the data actually has been dropped somewhere in which case you can clear the text box.
Since a drag & drop operation shouldn't start before the mouse has been moved a bit while pressing the mouse button you need to check for that in the MouseDown and MouseMove events. SystemInformation.DragSize tells you how far the mouse should be moved before a drag & drop operation starts.
In the MouseDown event check if you actually want to start a drag (i.e left button is pressed and text box actually contains text). Then create a rectangle using the mouse location and the size given by SystemInformation.DragSize. In the MouseMove event check if the mouse is dragged outside the rectangle and call DoDragDrop:
Private _dragStart As Boolean
Private _dragBox As Rectangle
Private Sub srcTextBox_MouseDown(sender As Object, e As MouseEventArgs) Handles srcTextBox.MouseDown
' a drag starts if the left mouse button is pressed and the text box actually contains any text
_dragStart = e.Button = MouseButtons.Left And Not String.IsNullOrEmpty(srcTextBox.Text)
If _dragStart Then
Dim dragSize As Size = SystemInformation.DragSize
_dragBox = New Rectangle(New Point(e.X - (dragSize.Width \ 2),
e.Y - (dragSize.Height \ 2)), dragSize)
End If
End Sub
Private Sub srcTextBox_MouseUp(sender As Object, e As MouseEventArgs) Handles srcTextBox.MouseUp
_dragStart = False
End Sub
Private Sub srcTextBox_MouseMove(sender As Object, e As MouseEventArgs) Handles srcTextBox.MouseMove
If Not _dragStart Or
(e.Button And MouseButtons.Left) <> MouseButtons.Left Or
_dragBox.Contains(e.X, e.Y) Then Return
Dim data As New DataObject()
data.SetData(srcTextBox.Text)
' you can optionally add more formats required by valid drag destinations:
' data.SetData(DataFormats.UnicodeText, Encoding.Unicode.GetBytes(srcTextBox.Text))
' data.SetData("UTF-8", Encoding.UTF8.GetBytes(srcTextBox.Text))
' data.SetData("UTF-32", Encoding.UTF32.GetBytes(srcTextBox.Text))
Dim dropEffect As DragDropEffects = srcTextBox.DoDragDrop(data, DragDropEffects.Move)
If (dropEffect = DragDropEffects.Move) Then
srcTextBox.Text = ""
End If
_dragStart = False
_dragBox = Rectangle.Empty
End Sub
Private Sub destTextBox_DragOver(ByVal sender As Object, ByVal e As DragEventArgs) Handles destTextBox.DragOver
If e.Data.GetDataPresent(GetType(String)) Then
e.Effect = e.AllowedEffect And DragDropEffects.Move
Else
e.Effect = DragDropEffects.None
End If
End Sub
Private Sub destTextBox_DragDrop(ByVal sender As Object, ByVal e As DragEventArgs) Handles destTextBox.DragDrop
If e.Data.GetDataPresent(GetType(String)) Then
destTextBox.Text = e.Data.GetData(GetType(String)).ToString()
End If
End Sub
Dragging the mouse in a TextBox usually starts text selection. The above code changes this behavior. Users can't use the mouse any more to select text. This is obviously not a good idea since users wouldn't expect that. To allow both text selection with the mouse and dragging you need to control the selection mechanism. This means you need to create your own text box class.
I would suggest a different approach: Use a label that shows the value as the dragging source and/or destination. To allow editing you can create a hidden text box. If the user double clicks on the label you hide the label and show the text box. After the user finishes editing (by hitting enter or cancel) or if the text box looses focus you hide the text box and show the label again.
Check out the DragLeave Event on the TextBox
Easiest way will probably be to store it as a variable or in clip board if leaving app.
Private Sub TheTextBox_DragLeave(sender As System.Object, e As System.EventArgs) Handles TheTextBox.DragLeave
Clipboard.SetText(TheTextBox.Text)
TheTextBox.Clear() 'Optional
End Sub
Then you'll need to code what happens when you mouse up of course, or drag into or whatever. You could clear the textbox in one of these steps. Depends on your implementation.
I would like to know how do I change the border color and border width of textbox as something shown below
If it is mouse hover I need to display one colour and on mouse down I need to display another colour.
Can anyone explain me the detailed process with the source if available.
You could do the following:
Place the TextBox inside a Panel
Give the panel 1 pixel padding
Set the text dock to Fill
Make the text box to have no border
Then, handle mouse events on the text box, switch the background color of the panel between your two colors, when the mouse enters/leaves.
This isn't the most elegant approach in terms of using resources/handles but it should work without any custom drawing.
Same as above with a little twist. Unfortunately I can't comment due to reputation.
Make a UserControl
Set usercontrol padding on all to 1
Put a Panel inside the usercontrol
Set panel dock style to fill
Set panel padding to 6, 3, 6, 3 (left, top, right, bottom)
Put a TextBox inside the panel
Set textbox dock style to fill
Set textbox borderstyle to None
...then for border colour changing properties, you could use this
Dim tbxFocus As Boolean = False
Private Sub tbx_GotFocus(sender As Object, e As EventArgs) Handles tbx.GotFocus
tbxFocus = True
Me.BackColor = Color.CornflowerBlue
End Sub
Private Sub tbx_LostFocus(sender As Object, e As EventArgs) Handles tbx.LostFocus
tbxFocus = False
Me.BackColor = SystemColors.Control
End Sub
Private Sub tbx_MouseEnter(sender As Object, e As EventArgs) Handles tbx.MouseEnter
If tbxFocus = False Then Me.BackColor = SystemColors.ControlDark
End Sub
Private Sub tbx_MouseLeave(sender As Object, e As EventArgs) Handles tbx.MouseLeave
If tbxFocus = False Then Me.BackColor = SystemColors.Control
End Sub
It's pretty self-explanatory.