Snippet

Jak umožnit přemisťování komponent na formuláři pomocí myši

Přidáno: 18.7.2007 Kategorie: VB.NET - Komponenty Autor: Vratislav Renner
Kód je dost okomentovaný, tak více snad není potřeba.
' Jak umožnit přemisťování komponent formuláře pomocí myši
' --------------------------------------------------------
' Nejedná se o metodu DragDrop
' Na formuláři jsou tři komponenty, které lze přemisťovat levým tlač. myši: 
'   -  dva obrazové boxy PictureBox1 a PictureBox2
'   -  tlačítko Button1 (ukončí program, pokud nebylo při kliknutí přesunuto)
'------------------------------------------------------------
Public Class Form1
  Private btnKonecLoc As Point ' pro zachycení pozice tlačítka s funkcí konec
  Private mysiPosun As Point ' pro zachycení posunu komponent

  Private Sub PictureBox_MouseDown(ByVal sender As Object, _
    ByVal e As System.Windows.Forms.MouseEventArgs) _
    Handles PictureBox1.MouseDown, PictureBox2.MouseDown

    ' zachytíme výchozí pozici při stisku levého tlačítka myši 
    ' na některém z PictureBox - komponenta není indexována,
    ' všimněte si  Handles - procedura poslouží pro oba pic. boxy 

    mysiPosun = New Point(-e.X - Me.Left, -e.Y - Me.Top - 30)
    ' -30 opravuje fakt, že se systém nepočítá s výškou titulkového pruhu formuláře (?)
  End Sub

  Private Sub PictureBox_MouseMove(ByVal sender As Object, _
    ByVal e As System.Windows.Forms.MouseEventArgs) _
    Handles PictureBox1.MouseMove, PictureBox2.MouseMove

    ' opět si všimněte Handles - procedura také poslouží pro oba picture boxy. 
    ' Je-li stlačeno levé tl. myši a mění se poloha kurzoru
    ' komponetu lze přetáhnout na jiné místo formuláře:

    If e.Button = Windows.Forms.MouseButtons.Left Then
      Dim pbox As PictureBox = sender ' pro určení aktivního picture boxu
      Dim mousePos As Point = Control.MousePosition ' zachycení polohy myši
      mousePos.Offset(mysiPosun.X, mysiPosun.Y) ' zachycení změn polohy kuroru
      pbox.Location = mousePos ' posun komponenty
    End If
  End Sub

  Private Sub Command1_MouseDown(ByVal sender As Object, _
  ByVal e As System.Windows.Forms.MouseEventArgs) Handles Button1.MouseDown

    ' obdoba toho, co je popsáno pro PictureBox, bude fungovat třeba i na tlačítko:

    mysiPosun = New Point(-e.X - Me.Left, -e.Y - Me.Top - 30)
    btnKonecLoc = Button1.Location ' zachycení polohy tlačítka
  End Sub

  Private Sub Command1_MouseMove(ByVal sender As Object, _
  ByVal e As System.Windows.Forms.MouseEventArgs) Handles Button1.MouseMove
    ' obdoba  toho, co je popsáno pro PictureBox, další komentář netřeba
    Dim btn As Button = sender
    If e.Button = Windows.Forms.MouseButtons.Left Then
      Dim mousePos As Point = Control.MousePosition
      mousePos.Offset(mysiPosun.X, mysiPosun.Y)
      btn.Location = mousePos
    End If
  End Sub

  Private Sub Button1_Click(ByVal sender As System.Object, _
    ByVal e As System.EventArgs) Handles Button1.Click

    ' pokud při kliknutí nebylo tlačítkem posunuto, klik ukončí program
    If btnKonecLoc = Button1.Location Then Me.Close()
  End Sub
End Class