Kirjautuminen
Tehtävät
Kilpailu
Alkuerät ovat ohi.
Seuraavanlainen ongelma.
ListBoxissa on lista tiedostoista (ei siis FileListBox) ja niiden järjestystä pitää voida muuttaa DragDrop menetelmällä. Minne pitää lisätä tarvittava koodi? En tunnu saavan kiinni oikeasta eventistä...
ListBoxissa on päällä seuraavat asetukset: OLEDragMode Automatic, OLEDropMode Manual. Eli visuaalisesti näyttää hyvältä.
Ja ennen kuin kukaan ihmettelee et miksi tiedostonimet on tavallisessa ListBoxissa, niin osa pitää pystyä poistamaan valinnasta ilman että ne deletoidaan tyystin.
DragDrop droppaa koko listboxin. Käytä ListIndex ominaisuutta sekä remove- ja additem-metodeja. Esim. näin
Private Sub List1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) I = List1.ListIndex m = List1.List(I) List1.RemoveItem I End Sub Private Sub List1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) List1.AddItem m, List1.ListIndex End Sub
Aihe siirtyy raahaamalla uuteen paikkaan
Tällä koodilla kahden rivin sisältö vaihtuu keskenään.
Dim aloitus As Integer
Private Sub Form_Load()
'laitetaan listalle pari riviä esimerkin vuoksi
List1.AddItem "Rivi 1"
List1.AddItem "Rivi 2"
List1.AddItem "Rivi 3"
List1.AddItem "Rivi 4"
End Sub
Private Sub List1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'jos painettiin hiiren vasenta nappia...
If Button = 1 Then
'...otetaan talteen valitun rivin indeksi
aloitus = List1.ListIndex
End If
End Sub
Private Sub List1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim vaihto As String
'jos hiiren vasen nappi päästettiin...
If Button = 1 Then
'...vaihdetaan nykyisen kohdan ja aloituskohdan teksti keskenään
vaihto = List1.List(aloitus)
List1.List(aloitus) = List1.List(List1.ListIndex)
List1.List(List1.ListIndex) = vaihto
End If
End SubTällä koodilla koko listan sisältö liukuu alemmas tai ylemmäs:
Dim aloitus As Integer
Private Sub Form_Load()
'laitetaan listalle pari riviä esimerkin vuoksi
List1.AddItem "Rivi 1"
List1.AddItem "Rivi 2"
List1.AddItem "Rivi 3"
List1.AddItem "Rivi 4"
End Sub
Private Sub List1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'jos painettiin hiiren vasenta nappia...
If Button = 1 Then
'...otetaan talteen valitun rivin indeksi
aloitus = List1.ListIndex
End If
End Sub
Private Sub List1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim vaihto As String, lopetus As Integer
'jos hiiren vasen nappi päästettiin...
If Button = 1 Then
lopetus = List1.ListIndex
'jos riviä siirretään ylemmäs...
If lopetus < aloitus Then
List1.AddItem List1.List(aloitus), lopetus
List1.RemoveItem aloitus + 1
'jos riviä siirretään alemmas...
ElseIf lopetus > aloitus Then
List1.AddItem List1.List(aloitus), lopetus + 1
List1.RemoveItem aloitus
End If
End If
End SubTesteissäni huomasin, että joissain tapauksissa rivien siirtäminen ei onnistunut, vaan hiiren osoitin muuttui kieltomerkiksi. Tähän ongelmaan en löytänyt ratkaisua.
Setä:
lainaus:
DragDrop droppaa koko listboxin.
Huomasin kans saman, kun yritin saada homman toimimaan.
Kiitos molemmille vinkeistä. Pääsen näillä taas eteenpäin. =)
Setä ja Antti vastasivat kysymykseeni, mutta ne ei ollut aivan sitä mitä etsin. Seuraavassa koodi ListBoxin Drag'n'Dropin ohjaukseen.
Formilla ListBox (List1), jonka MultiSelect = 2.
Option Explicit
Private fromIndex As Integer
Private Sub Form_Load()
Dim i As Integer
Set Me.Font = List1.Font
With List1
For i = 1 To 20
.AddItem "hello " & Format(i, "00")
Next i
.OLEDragMode = 1
.OLEDropMode = 1
End With
End Sub
Private Sub List1_OLEDragDrop(Data As DataObject, _
Effect As Long, _
Button As Integer, _
Shift As Integer, _
X As Single, _
Y As Single)
Dim dropRowNum As Integer, visRows As Integer, i As Integer
Dim abu As Integer, abuRowNum As Integer
Dim midData As String
dropRowNum = List1.ListIndex
abuRowNum = dropRowNum
Select Case dropRowNum
Case Is = fromIndex
Beep
Case Is > fromIndex
i = 1
abu = InStr(i, Data.GetData(1), vbCrLf)
If abu > 0 Then
Do
midData = Mid(Data.GetData(1), i, (abu - i))
abuRowNum = abuRowNum + 1
List1.AddItem midData, abuRowNum
i = abu + 2
abu = InStr(i, Data.GetData(1), vbCrLf)
Loop Until abu = 0
midData = Mid(Data.GetData(1), i, Len(Data.GetData(1)))
abuRowNum = abuRowNum + 1
List1.AddItem midData, abuRowNum
i = 0
Do Until i > List1.ListCount - 1
Do Until Not List1.Selected(i)
List1.RemoveItem i
Loop
i = i + 1
Loop
Else
List1.AddItem Data.GetData(1), dropRowNum + 1
i = 0
Do Until i > List1.ListCount - 1
Do Until Not List1.Selected(i)
List1.RemoveItem i
Loop
i = i + 1
Loop
End If
List1.ListIndex = dropRowNum
List1.Refresh
Case Is < fromIndex
i = 1
abu = InStr(i, Data.GetData(1), vbCrLf)
If abu > 0 Then
abuRowNum = abuRowNum - 1
Do
midData = Mid(Data.GetData(1), i, abu - i)
abuRowNum = abuRowNum + 1
List1.AddItem midData, abuRowNum
i = abu + 2
abu = InStr(i, Data.GetData(1), vbCrLf)
Loop Until abu = 0
midData = Mid(Data.GetData(1), i, Len(Data.GetData(1)))
abuRowNum = abuRowNum + 1
List1.AddItem midData, abuRowNum
i = List1.ListCount - 1
Do Until i = 0
If List1.Selected(i) Then List1.RemoveItem i
i = i - 1
Loop
Else
List1.AddItem Data.GetData(1), dropRowNum
i = List1.ListCount - 1
Do Until i = 0
If List1.Selected(i) Then List1.RemoveItem i
i = i - 1
Loop
End If
List1.ListIndex = dropRowNum
List1.Refresh
End Select
End Sub
Private Sub List1_OLEDragOver(Data As DataObject, _
Effect As Long, _
Button As Integer, _
Shift As Integer, _
X As Single, _
Y As Single, _
State As Integer)
Dim selRow As Integer
selRow = CInt((Y / Me.TextHeight("Hello1")))
If selRow > (List1.ListCount - 1) Then: selRow = List1.ListCount - 1
List1.ListIndex = selRow
End Sub
Private Sub List1_OLEStartDrag(Data As DataObject, AllowedEffects As Long)
fromIndex = List1.ListIndex
AllowedEffects = 2
End Subjumalattoman pitkä koodi. Jos vain järjestystä piti voida muuttaa, niin miksi ihmeessä näin paljon koodia. Omassa koodissani oli kyllä se vika, että valintamahdollisuus jäi tuollaisenaan pois, koska klikkaus aina poisti aiheen. Jos koodiin lisää, että on painettava Shift alas, niin silloin ilman Shiftiä voi tehdä valinnan. Kyllä se ainakin minulla toimi.
lainaus:
jumalattoman pitkä koodi. Jos vain järjestystä piti voida muuttaa, niin miksi ihmeessä näin paljon koodia.
Jokainen tekee tyylillään. ;) Pääasia kuitenkin, että saa ohjelman tekemään sen mitä haluaa...
Aihe on jo aika vanha, joten et voi enää vastata siihen.