Kirjautuminen

Haku

Tehtävät

Kilpailu

Putka Open 2025
4. kierros:
7.11. klo 18 – 9.11. klo 23

Keskustelu: Ohjelmointikysymykset: VB.NET: [vb2009] tekstin siirtäminen listboxista toiseen listboxiin

jokke568 [06.10.2009 14:35:47]

#

Hei

Mitenkäs onnistuu listbox1:stä valitun tekstin siirtäminen listbox2:seen tai listbox3:seen hiirellä vetämällä ja tiputtamalla. Muutin listboxiin allowdropin arvoksi true. Aloin kirjoittamaan ListBox1_DragDrop(ByVal sender As...... koodia, mutta nyt tökkäsi pahankerran.

Apuja....

Jokke

neau33 [06.10.2009 20:53:36]

#

Moikka taas jokke568!

ehkä saat jotain ideaa oheisesta non DragDrop viritelmästä...

Public Partial Class MainForm

   ' raahaminen toimii, kun Listbox1
   ' valintaa ensin klikataan hiirellä
   ' (ja Listboxit ovat rinnakkain)
   Private DragNdrop As Boolean = False

   Public Sub New()
      Me.InitializeComponent()
   End Sub

   Sub MainFormLoad(sender As Object, e As EventArgs)
      Label1.Visible = False
   End Sub

   Sub ListBox1MouseDown(sender As Object, e As MouseEventArgs)

      Label1.Visible = True
      Label1.Text = ListBox1.SelectedItem.ToString
      Label1.Height = ListBox1.ItemHeight
      Label1.Width = ListBox1.Width - 2
      Label1.Left = ListBox1.Left  + 1
      Label1.Top = ListBox1.Top + (Label1.Height * _
      ListBox1.SelectedIndex) + 2

   End Sub

   Sub Label1MouseMove(sender As Object, _
   e As MouseEventArgs)

      If e.Button.ToString = "Left" And _
      Label1.Left < ListBox2.Left And _
      Label1.Top > ListBox2.Top And _
      Label1.Top < ListBox2.Top + _
      ListBox1.Height Then
         Label1.Left = e.X + ListBox1.Left + 1
         Label1.Top = e.Y + ListBox1.Top + _
         (Label1.Height * listBox1.SelectedIndex)
         DragNdrop = True
      End If

   End Sub

   Sub Label1MouseUp(sender As Object, _
   e As MouseEventArgs)

      If DragNdrop And Label1.Left >= _
         ListBox2.Left - 15 Then

         Label1.Visible = False

         '---
         Listbox2.Items.Add(Label1.Text)
         ListBox1.Items.RemoveAt( _
         ListBox1.SelectedIndex)
         '(poistaa listbox1:stä valitun)
         '---

         Label1.Text = ""
         Listbox2.SelectedIndex = _
         Listbox2.Items.Count -1
      Else
         Label1.Text = ""
         Label1.Visible = False
      End If

      DragNDrop = False

   End Sub

End Class

neau33 [06.10.2009 21:51:41]

#

Moikka taas jokke568!

tässä kuitenkin aito VB.NET DragDrop viritelmä...

Public Partial Class MainForm

   Public Sub New()
      Me.InitializeComponent()
   End Sub

   Sub MainFormLoad(sender As Object, e As EventArgs)
      KohdeListBox1.AllowDrop = True
   End Sub

   Sub LähdeListBoxMouseDown( _
   sender As Object, e As MouseEventArgs)

      DoDragDrop(LähdeListBox, _
      DragDropEffects.Copy)

   End Sub

   Sub KohdeListBox1DragEnter( _
   sender As Object, e As DragEventArgs)

      If e.Data.GetDataPresent(GetType(ListBox)) Then
         e.Effect = DragDropEffects.Copy
      Else
         e.Effect = DragDropEffects.None
      End If

   End Sub

   Sub KohdeListBox1DragDrop( _
   sender As Object, e As DragEventArgs)

      Dim lstBox As ListBox = DirectCast( _
      e.Data.GetData(GetType(ListBox)), ListBox)

      KohdeListBox1.Items.Add( _
      lstBox.SelectedItem.ToString)

      KohdeListBox1.SelectedIndex = _
      KohdeListBox1.Items.Count - 1

      '--- poistaa...
      LähdeListBox.Items.RemoveAt( _
      LähdeListBox.SelectedIndex)
      '...lähdeboxista valitun.

   End Sub

End Class

neau33 [07.10.2009 21:16:17]

#

Moikka taas jokke568!

tässä vielä ListBox DragDrop viritelmä VBA-versiona...

' VBA Projekti - ListBoxDragDrop
' Formille:
' 2 ListBox-kontrollia (lstSource, lstTarget1)
' 1 Frame (frmSource)
' 1 Label (lblSource)
'(sijoita lblSource frmSource'n sisälle)

Private SelectedIndex As Integer
Private RelativeLeft As Long
Private RelativeTop As Long

Private Sub UserForm_Activate()

   Static IsInitialized As boolean

   If Not IsInitialized Then

      IsInitialized = True

      For i = 1 To 5
         lstSource.AddItem "Valinta " & CStr(i) 'esim.
      Next i

      lstSource.TopIndex = 0
      lstSource.ListIndex = 0
      frmSource.Height = 1.24 * lstSource.Font.Size
      frmSource.Width = lstSource.Width - 4
      frmSource.Left = lstSource.Left + 2
      frmSource.BorderStyle = fmBorderStyleNone
      frmSource.BackColor = &H8000000D
      lblSource.BorderStyle = fmBorderStyleNone
      lblSource.BackColor = frmSource.BackColor
      lblSource.Font = lstSource.Font
      lblSource.Font.Size = lstSource.Font.Size
      lblSource.Width = frmSource.Width - 7
      lblSource.Left = 7
      lblSource.Height = frmSource.Height
      lblSource.Top = -1

   End If

End Sub

Private Sub lstSource_MouseMove(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

   If lstSource.ListCount > 0 Then
      SetSelected
   End If

   If SelectedIndex > -1 Then

      frmSource.Visible = True
      frmSource.Enabled = True
      frmSource.Controls("lblSource").Caption = _
      lstSource.List(SelectedIndex)
      frmSource.SetFocus
      lstSource.ZOrder 1
      frmSource.Top = lstSource.Top + 2 + _
      (frmSource.Height * SelectedIndex)
      RelativeLeft = lstSource.Left _
      + frmSource.Left + lblSource.Left - 15
      RelativeTop = lstSource.Top _
      + frmSource.Top + lblSource.Top - 15

   End If

End Sub

Private Sub lstSource_MouseDown(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

   If lstSource.ListCount > 0 And Button = 1 Then
      SetSelected
      If SelectedIndex > -1 Then
         'lblSource.MouseIcon = ...
         '(lataa kuvake ominaisuusikkunasta)
         lblSource.MousePointer = _
         fmMousePointerCustom
      Else
         lblSource.MousePointer = _
         fmMousePointerNoDrop
      End If
   End If

End Sub

Private Sub lblSource_MouseUp(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

   ' Koordinaatit eivät ole 100%'ia, mutta
   ' riittävän tarkkoja testaamiseen...
   ' jos haluat säätää koordinaatit täysin absoluuttisiksi
   ' niin rakentele VBA:lle Screen objekti - ohjeet löytyy [linkki "https://www.ohjelmointiputka.net/keskustelu/16671-moniajo-oppaasta"]täältä[/linkki]

   Dim DropReady As Boolean
   DropReady = CLng(X + RelativeLeft - _
   lstTarget1.Left) > 0 _
   And CLng((X + RelativeLeft) - _
   (lstTarget1.Left + lstTarget1.Width)) < 0 _
   And CLng(Y + RelativeTop - lstTarget1.Top) > 0 _
   And CLng((Y + RelativeTop) - _
   (lstTarget1.Top + lstTarget1.Height)) < 0 _
   And SelectedIndex > -1 And Button = 1

   If DropReady Then

      lstTarget1.AddItem _
      lstSource.List(SelectedIndex)
      lstSource.RemoveItem _
      (SelectedIndex)
      SelectedIndex = -1
      lstTarget1.SetFocus
      lstTarget1.ListIndex = _
      lstTarget1.ListCount - 1
      frmSource.Visible = False
      frmSource.Enabled = False
      SelectedIndex = -1

   End If

   If SelectedIndex = -1 Then
      lblSource.MousePointer = _
      fmMousePointerDefault
   End If

End Sub

Sub SetSelected()

   lstSource.Selected(lstSource.ListIndex) = True
   SelectedIndex = lstSource.ListIndex

End Sub

jokke568 [11.10.2009 18:19:40]

#

Suuri kiitos Nea!

jokke568 [21.10.2009 10:16:27]

#

Hei

Ratkaisuni....

Public Class Form1
    Public SIIRTO As String = ""
    Public ruutu As Integer = 0

    Private Sub ListBox1_MouseClick(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles ListBox1.MouseClick
        If ruutu = 0 And SIIRTO = "" Then SIIRTO = ListBox1.Text : ruutu = 1 : Exit Sub

        If SIIRTO <> "" Then

            If ruutu = 3 Then
                ListBox1.Items.Add(SIIRTO)
                ListBox2.Items.Remove(SIIRTO)
                ruutu = 0
                SIIRTO = ""
            End If
            If ruutu = 2 Then
                ListBox1.Items.Add(SIIRTO)
                ListBox3.Items.Remove(SIIRTO)
                ruutu = 0
                SIIRTO = ""
            End If
            If ruutu = 4 Then
                ListBox1.Items.Add(SIIRTO)
                ListBox4.Items.Remove(SIIRTO)
                ruutu = 0
                SIIRTO = ""
            End If

        End If
    End Sub

    Private Sub ListBox2_MouseClick(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles ListBox2.MouseClick

        If ruutu = 0 And SIIRTO = "" Then SIIRTO = ListBox2.Text : ruutu = 3 : Exit Sub

        If SIIRTO <> "" Then

            If ruutu = 1 Then
                ListBox2.Items.Add(SIIRTO)
                ListBox1.Items.Remove(SIIRTO)
                ruutu = 0
                SIIRTO = ""
            End If
            If ruutu = 2 Then
                ListBox2.Items.Add(SIIRTO)
                ListBox3.Items.Remove(SIIRTO)
                ruutu = 0
                SIIRTO = ""
            End If
            If ruutu = 4 Then
                ListBox2.Items.Add(SIIRTO)
                ListBox4.Items.Remove(SIIRTO)
                ruutu = 0
                SIIRTO = ""
            End If

        End If
    End Sub


    Private Sub ListBox3_MouseClick(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles ListBox3.MouseClick
        If ruutu = 0 And SIIRTO = "" Then SIIRTO = ListBox3.Text : ruutu = 2 : Exit Sub

        If SIIRTO <> "" Then

            If ruutu = 1 Then
                ListBox3.Items.Add(SIIRTO)
                ListBox1.Items.Remove(SIIRTO)
                ruutu = 0
                SIIRTO = ""
            End If
            If ruutu = 3 Then
                ListBox3.Items.Add(SIIRTO)
                ListBox2.Items.Remove(SIIRTO)
                ruutu = 0
                SIIRTO = ""
            End If
            If ruutu = 4 Then
                ListBox3.Items.Add(SIIRTO)
                ListBox4.Items.Remove(SIIRTO)
                ruutu = 0
                SIIRTO = ""
            End If

        End If
    End Sub


    Private Sub ListBox4_MouseClick(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles ListBox4.MouseClick
        If ruutu = 0 And SIIRTO = "" Then SIIRTO = ListBox4.Text : ruutu = 4 : Exit Sub

        If SIIRTO <> "" Then

            If ruutu = 1 Then
                ListBox4.Items.Add(SIIRTO)
                ListBox1.Items.Remove(SIIRTO)
                ruutu = 0
                SIIRTO = ""
            End If
            If ruutu = 2 Then
                ListBox4.Items.Add(SIIRTO)
                ListBox3.Items.Remove(SIIRTO)
                ruutu = 0
                SIIRTO = ""
            End If
            If ruutu = 3 Then
                ListBox4.Items.Add(SIIRTO)
                ListBox2.Items.Remove(SIIRTO)
                ruutu = 0
                SIIRTO = ""
            End If

        End If
    End Sub

    Private Sub ListBox4_MouseDoubleClick(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles ListBox4.MouseDoubleClick
        ruutu = 0 : SIIRTO = ""
    End Sub

    Private Sub ListBox1_MouseDoubleClick(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles ListBox1.MouseDoubleClick
        ruutu = 0 : SIIRTO = ""

    End Sub

    Private Sub ListBox2_MouseDoubleClick(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles ListBox2.MouseDoubleClick
        ruutu = 0 : SIIRTO = ""
    End Sub

    Private Sub ListBox3_MouseDoubleClick(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles ListBox3.MouseDoubleClick
        ruutu = 0 : SIIRTO = ""
    End Sub

End Class

Vastaus

Aihe on jo aika vanha, joten et voi enää vastata siihen.

Tietoa sivustosta