I want to Drag Move a userControl which is in a canvas(named as grd) and that canvas is in a larger canvas on which there are a lot of other controls. I am using this code, but it does not work. I am making mouseDown and MouseUpevents of userControl and a MouseMve event of the larger canvas which has a lot of controls.
Where is the problem?
Dim _pressed As Boolean = False
Dim grd As Canvas
Dim mp As Point
Private Sub DeviceIcon_MouseLeftButtonDown(ByVal sender As Object, ByVal e As System.Windows.Input.MouseButtonEventArgs)
_pressed = True
grd = sender
mp = mousePosition
End Sub
Private Sub DeviceIcon_MouseLeftButtonUp(ByVal sender As Object, ByVal e As System.Windows.Input.MouseButtonEventArgs)
_pressed = False
End Sub
Private Sub gridimgFloor_MouseMove(ByVal sender As System.Object, ByVal e As System.Windows.Input.MouseEventArgs) Handles gridimgFloor.MouseMove
If _pressed = False Then Exit Sub
Dim nmp As Point = mousePosition
Dim _x As Integer = nmp.X - mp.X
Dim _y As Integer = nmp.Y - mp.Y
Dim thk As Thickness = grd.Margin
thk.Left = thk.Left + _x
thk.Top = thk.Top + _y
grd.Margin = thk
mp = nmp
End Sub
You should use e.GetPosition(parentControl) to get the position from the event args.
Related
I want to resize a custom window, so windowstyle=none.
For that I do not want to use some Open-Sourelib.
So I found this article via google.
After I changed the code a bit, since i want to use a button instead of a rectangle for resizing the code looks like this:
Private bottomResize As Boolean = False
Private initBtmY As Double
Private Sub BottomResizeRect_MouseEnter _
(ByVal sender As Object, ByVal e As _
System.Windows.Input.MouseEventArgs) _
Handles btResizeAndFold.MouseEnter
bottomResize = False
'Console.WriteLine("Mouse Enter called")
End Sub
Dim boing As Boolean = False
Private Sub BottomResizeRect_MouseLeftButtonDown _
(ByVal sender As Object, ByVal e As _
System.Windows.Input.MouseButtonEventArgs) _
Handles btResizeAndFold.PreviewMouseLeftButtonDown
bottomResize = True
boing = True
'Console.WriteLine("Mouse left down called")
'Get the initial Y coordinate
'cursor location on our window
initBtmY = e.GetPosition(Me).Y
End Sub
Private Sub BottomResizeRect_MouseLeftButtonUp _
(ByVal sender As Object,
ByVal e As System.Windows.Input.MouseButtonEventArgs) _
Handles btResizeAndFold.PreviewMouseLeftButtonUp
'Console.WriteLine("Mouse left up called")
bottomResize = False
btResizeAndFold.ReleaseMouseCapture()
End Sub
Private Sub BottomResizeRect_MouseMove _
(ByVal sender As Object, ByVal e As _
System.Windows.Input.MouseEventArgs) _
Handles btResizeAndFold.PreviewMouseMove
'Get the new Y coordinate cursor location
Dim newBtmY As Double = e.GetPosition(Me).Y
'Get the change between the initial and
'new cursor location
Dim diff As Double = initBtmY - newBtmY
'Minimum window height
Dim minHeight As Integer = 200
Dim differnceConstant = 5
If bottomResize = True And (diff > differnceConstant Or diff < (differnceConstant * -1)) Then
'Let our rectangle capture the mouse
btResizeAndFold.CaptureMouse()
Dim newHeight = e.GetPosition(Me).Y - diff
If newHeight > minHeight Then
Me.Height = newHeight
End If
End If
End Sub
The problem now is, that if i try to resize my window by pressing the left mouse button and then drag the mouse, the increase/decrease of the height of my window is not synchonosly to the movement of my mouse cursor, so the question is: how to make the movement of the mouse sychronos to growth of the window
Instead of Button you could use Thumb, which provide with DragDelta Event that suits your requirement:
https://wpf.2000things.com/2012/12/19/715-using-the-thumb-control-to-drag-objects-on-a-canvas/
That way you dont need to capture the mouse(you shouldnt've put the CaptureMouse in the PreivewMouseMove anyway, it will do that a lot).
And just set the height as the current height + the delta Y.
Right now if I click Button A, Button B shows a DropShadow effect:
Private Sub ButtonA_Click(ByVal sender As System.Object, ByVal e As System.Windows.RoutedEventArgs) Handles ButtonA.Click
Dim objDropShadow As New DropShadowEffect
objDropShadow.ShadowDepth = 0
objDropShadow.BlurRadius = 30
objDropShadow.Color = Colors.GreenYellow
Me.ButtonB.Effect = objDropShadow
End Sub
If I clicked Button C how would I remove the DropShadow effect from Button B ?
Try it
Me.ButtonB.Effect = Nothing // VB.Net
this.ButtonB.Effect = null; // C#
Private Sub ButtonC_Click(
ByVal sender As System.Object,
ByVal e As System.Windows.RoutedEventArgs) Handles ButtonC.Click
Dim objDropShadow As New DropShadowEffect
objDropShadow.ShadowDepth = 0
objDropShadow.BlurRadius = 0
objDropShadow.Color = Colors.Transparent
Me.ButtonB.Effect = objDropShadow
End Sub
I am developing a WinForms application and I want a ListBox (or a control which provides list of strings) such that when the user hovers the mouse over an item it will show a delete sign for that particular item.
Is there any control available for WinForms to do this?
Setting the ListBox DrawMode to OwnerDrawFixed (or OwnerDrawVariable), you can just handle this yourself with the Mouse events:
Public Class Form1
Private _MouseIndex As Integer = -1
Private Sub Form1_Load(ByVal sender As Object, ByVal e As EventArgs) Handles MyBase.Load
ListBox1.Items.Add("String #1")
ListBox1.Items.Add("String #2")
End Sub
Private Sub ListBox1_DrawItem(ByVal sender As Object, ByVal e As DrawItemEventArgs) Handles ListBox1.DrawItem
e.DrawBackground()
If e.Index > -1 Then
Dim brush As Brush = SystemBrushes.WindowText
If (e.State And DrawItemState.Selected) = DrawItemState.Selected Then
brush = SystemBrushes.HighlightText
End If
e.Graphics.DrawString(ListBox1.Items(e.Index), e.Font, brush, e.Bounds.Left + 20, e.Bounds.Top)
If e.Index = _MouseIndex Then
e.Graphics.DrawString("X", e.Font, brush, e.Bounds.Left + 2, e.Bounds.Top)
End If
End If
End Sub
Private Sub ListBox1_MouseDown(ByVal sender As Object, ByVal e As MouseEventArgs) Handles ListBox1.MouseDown
If _MouseIndex > -1 AndAlso ListBox1.IndexFromPoint(e.Location) = _MouseIndex AndAlso e.Location.X < 20 Then
Dim index As Integer = _MouseIndex
If MessageBox.Show("Do you want to delete this item?", "Confirm", MessageBoxButtons.YesNo, MessageBoxIcon.Question) = DialogResult.Yes Then
ListBox1.Items.RemoveAt(index)
ListBox1.Invalidate()
End If
End If
End Sub
Private Sub ListBox1_MouseLeave(ByVal sender As Object, ByVal e As EventArgs) Handles ListBox1.MouseLeave
If _MouseIndex <> -1 Then
_MouseIndex = -1
ListBox1.Invalidate()
End If
End Sub
Private Sub ListBox1_MouseMove(ByVal sender As Object, ByVal e As MouseEventArgs) Handles ListBox1.MouseMove
Dim index As Integer = ListBox1.IndexFromPoint(e.Location)
If index <> _MouseIndex Then
_MouseIndex = index
ListBox1.Invalidate()
End If
End Sub
End Class
Refactor as needed.
Here is my code and I am able to add the text by defining some font properties but I want to add this using Font dialog.Can anyone help me regarding this issue.
Public Class Form1
Dim pic_font As New Font("Arial Black", 40, FontStyle.Regular, GraphicsUnit.Pixel)
Dim bm As Bitmap = New Bitmap(100, 100)
Dim strText As String = "Diver Dude"
Dim szText As New SizeF
Dim ptText As New Point(125, 125)
Dim ptsText() As PointF
Dim MovingOffset As PointF
Dim ptsTextPen As Pen = New Pen(Color.LightSteelBlue, 1)
Dim MouseMoving As Boolean
Dim MouseOver As Boolean
Public Sub New()
MyBase.New()
'This call is required by the Windows Form Designer.
InitializeComponent()
'Add any initialization after the InitializeComponent() call
Me.SetStyle(ControlStyles.AllPaintingInWmPaint, True)
Me.SetStyle(ControlStyles.DoubleBuffer, True)
End Sub
Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
PictureBox1.Hide()
bm = Image.FromFile(Application.StartupPath & "\DivePic.bmp")
szText = Me.CreateGraphics.MeasureString(strText, pic_font)
SetptsText()
ptsTextPen.DashStyle = DashStyle.Dot
End Sub
Private Sub Form1_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseDown
'Check if the pointer is over the Text
If IsMouseOverText(e.X - 10, e.Y - 10) Then
MouseMoving = True
'Determine the upper left corner point from where the mouse was clicked
MovingOffset.X = e.X - ptText.X
MovingOffset.Y = e.Y - ptText.Y
Else
MouseMoving = False
End If
End Sub
Private Sub Form1_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseMove
'Check if the pointer is over the Text
If IsMouseOverText(e.X - 10, e.Y - 10) Then
If Not MouseOver Then
MouseOver = True
Me.Refresh()
End If
Else
If MouseOver Then
MouseOver = False
Me.Refresh()
End If
End If
If e.Button = Windows.Forms.MouseButtons.Left And MouseMoving Then
ptText.X = CInt(e.X - MovingOffset.X)
ptText.Y = CInt(e.Y - MovingOffset.Y)
Me.Refresh()
End If
End Sub
Private Sub Form1_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseUp
MouseMoving = False
Me.Refresh()
End Sub
Public Function IsMouseOverText(ByVal X As Integer, ByVal Y As Integer) As Boolean
'Make a Graphics Path from the rotated ptsText.
Using gp As New GraphicsPath()
gp.AddPolygon(ptsText)
'Convert to Region.
Using TextRegion As New Region(gp)
'Is the point inside the region.
Return TextRegion.IsVisible(X, Y)
End Using
End Using
End Function
Dim tbm As Bitmap
Private Sub Form1_Paint(ByVal sender As Object, _
ByVal e As System.Windows.Forms.PaintEventArgs) _
Handles MyBase.Paint
tbm = CType(bm.Clone, Bitmap)
Dim g As Graphics = Graphics.FromImage(tbm)
Dim mx As Matrix = New Matrix
Dim gpathText As New GraphicsPath
Dim br As SolidBrush = New SolidBrush(Color.FromArgb(tbarTrans.Value, _
KryptonColorButton1.SelectedColor))
SetptsText()
'Smooth the Text
g.SmoothingMode = SmoothingMode.AntiAlias
'Make the GraphicsPath for the Text
Dim emsize As Single = Me.CreateGraphics.DpiY * pic_font.SizeInPoints / 72
gpathText.AddString(strText, pic_font.FontFamily, CInt(pic_font.Style), _
emsize, New RectangleF(ptText.X, ptText.Y, szText.Width, szText.Height), _
StringFormat.GenericDefault)
'Draw a copy of the image to the Graphics Object canvas
g.DrawImage(CType(bm.Clone, Bitmap), 0, 0)
'Rotate the Matrix at the center point
mx.RotateAt(tbarRotate.Value, _
New Point(ptText.X + (szText.Width / 2), ptText.Y + (szText.Height / 2)))
'Get the points for the rotated text bounds
mx.TransformPoints(ptsText)
'Transform the Graphics Object with the Matrix
g.Transform = mx
'Draw the Rotated Text
If chkAddOutline.Checked Then
Using pn As Pen = New Pen(Color.FromArgb(tbarTrans.Value, KryptonColorButton2.SelectedColor), 1)
g.DrawPath(pn, gpathText)
End Using
Else
g.FillPath(br, gpathText)
End If
If CheckBox2.Checked = True Then
Dim p As New Pen(Color.FromArgb(tbarTrans.Value, KryptonColorButton2.SelectedColor), 1)
'draw te hollow outlined text
g.DrawPath(p, gpathText)
'clear the path
gpathText.Reset()
Else
g.FillPath(br, gpathText)
End If
'Draw the box if the mouse is over the Text
If MouseOver Then
g.ResetTransform()
g.DrawPolygon(ptsTextPen, ptsText)
End If
'Draw the whole thing to the form
e.Graphics.DrawImage(tbm, 10, 10)
'tbm.Dispose()
g.Dispose()
mx.Dispose()
br.Dispose()
gpathText.Dispose()
End Sub
Private Sub TrackBar_Scroll(ByVal sender As System.Object, ByVal e As System.EventArgs) _
Handles tbarRotate.Scroll, tbarTrans.Scroll
lblRotate.Text = tbarRotate.Value
lblOpacity.Text = tbarTrans.Value
Me.Refresh()
End Sub
Sub SetptsText()
'Create a point array of the Text Rectangle
ptsText = New PointF() { _
ptText, _
New Point(CInt(ptText.X + szText.Width), ptText.Y), _
New Point(CInt(ptText.X + szText.Width), CInt(ptText.Y + szText.Height)), _
New Point(ptText.X, CInt(ptText.Y + szText.Height)) _
}
End Sub
Private Sub chkAddOutline_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles chkAddOutline.CheckedChanged
Me.Refresh()
End Sub
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
If FontDialog1.ShowDialog = Windows.Forms.DialogResult.OK Then
End If
End Sub
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
If OpenFileDialog1.ShowDialog = Windows.Forms.DialogResult.OK Then
PictureBox1.Image = Image.FromFile(OpenFileDialog1.FileName)
bm = Image.FromFile(OpenFileDialog1.FileName)
szText = Me.CreateGraphics.MeasureString(strText, pic_font)
SetptsText()
ptsTextPen.DashStyle = DashStyle.Dot
End If
End Sub
Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
If SaveFileDialog1.ShowDialog = Windows.Forms.DialogResult.OK Then
tbm.Save(SaveFileDialog1.FileName)
End If
End Sub
End Class
What do you mean.If you mean open a font dialog and select a font from it,here is the code.
' You need Import System.Drawing before your class
' In your class vars section
Dim fd As New FontDialog
'later in your code
' This should be in the code where you call the font dialog
If(fd.ShowDialog() == DialogResults.Ok)
pic_font = fd.Font
End If
What's wrong in my code? It's not updating the TextBox and the ProgressBar while deleting files.
Imports System.Windows.Threading
Imports System.IO
Class MainWindow
Private Sub bt_Click(ByVal sender As Object,
ByVal e As RoutedEventArgs) Handles bt.Click
Dim sb As New System.Text.StringBuilder
Dim files = IO.Directory.EnumerateFiles(
My.Computer.FileSystem.SpecialDirectories.Temp, "*.*",
SearchOption.TopDirectoryOnly)
Dim count = files.Count
pb.Minimum = 0
pb.Maximum = count
For i = 0 To count - 1
Dim f = files(i)
Dispatcher.BeginInvoke(
New Action(Of String, Integer)(
Sub(str, int)
tb.SetValue(TextBox.TextProperty, str)
pb.SetValue(ProgressBar.ValueProperty, int)
End Sub),
DispatcherPriority.Send,
f, i + 1)
Try
File.Delete(f)
Catch ex As Exception
sb.AppendLine(f)
End Try
Dim exceptions = sb.ToString
Stop
Next
End Sub
End Class
I got this working with the BackgroundWorker object. This places your work in a background thread, with calls to update the UI going through the ProgressChanged event. I also used Invoke instead of BeginInvoke within the work loop, which forces the loop to wait for the UI to become updated before it proceeds.
Imports System.ComponentModel
Imports System.IO
Class MainWindow
Private WithEvents bw As New BackgroundWorker
Private Sub Button1_Click(ByVal sender As System.Object,
ByVal e As RoutedEventArgs) Handles btn.Click
pb.Minimum = 0
pb.Maximum = 100
bw.WorkerReportsProgress = True
bw.RunWorkerAsync()
End Sub
Private Sub bw_DoWork(ByVal sender As Object,
ByVal e As DoWorkEventArgs) Handles bw.DoWork
Dim sb As New System.Text.StringBuilder
Dim files = IO.Directory.EnumerateFiles(
My.Computer.FileSystem.SpecialDirectories.Temp, "*.*",
SearchOption.TopDirectoryOnly)
Dim count = files.Count
Me.Dispatcher.BeginInvoke(Sub()
tb.Text = "SOMETHING ELSE"
End Sub)
For i = 0 To count - 1
Dim f = files(i)
Dim myI = i + 1
Me.Dispatcher.Invoke(
Sub()
bw.ReportProgress(CInt((myI / count) * 100), f)
End Sub)
'Try
' File.Delete(f)
'Catch ex As Exception
' sb.AppendLine(f)
'End Try
Dim exceptions = sb.ToString
'Stop
Next
End Sub
Private Sub bw_ProgressChanged(
ByVal sender As Object,
ByVal e As ProgressChangedEventArgs) Handles bw.ProgressChanged
Dim fString As String = TryCast(e.UserState, String)
Me.Dispatcher.BeginInvoke(Sub()
tb.Text = fString
End Sub)
End Sub
End Class