Linewrap i ListView?!?!?!?!

Prøv at sætte LabelWrap til true

Det virker kun i lvwIcon...

k, så er det ikke umidelbart muligt

Det er ikke muligt i ListView, men det kræver ikke en datalog at skrive en OCX der kan gøre det - men det kræver mere end 15 point. :o)

jeg har desværre kun 20 points mere... :(

Jeg er på arbejde til kl. 22.00 i aften, men i min umådeligt overdrevne gavmildhed vil jeg se på det når jeg kommer hjem for de 15 point du allerede har sat på højkant i dette spm.

Er dette din mailadresse jps2mt@jps2mt.dk ?

Well, langt om længe kom jeg i tanke om at jeg havde lovet at lave en lille OCX fil - dog har jeg ikke adgang til en compiler, men her er sourcen som den ser ud ind til videre.

Der er kun få funktioner ind til videre og jeg gider ganske enkelt ikke se en linie kode mere i aften, men jeg vil arbejde videre med det så kontrollen får de samme (eller flere) funktioner som den fra MS.

Du kan cut'n paste den direkte over i Notepad og gemme den som ListView.ctl
- så er den lige til at importerer i dit VB project.

God fornøjelse. :o)

VERSION 5.00
Begin VB.UserControl ListView
  BackColor      =  &H80000005&
  BorderStyle    =  1  'Fixed Single
  ClientHeight    =  1230
  ClientLeft      =  0
  ClientTop      =  0
  ClientWidth    =  1935
  ScaleHeight    =  1230
  ScaleWidth      =  1935
  Begin VB.VScrollBar VScroll
      Height          =  1215
      Left            =  1680
      TabIndex        =  0
      TabStop        =  0  'False
      Top            =  0
      Width          =  255
  End
  Begin VB.VScrollBar VS
      Height          =  495
      Left            =  1800
      TabIndex        =  2
      Top            =  360
      Width          =  135
  End
  Begin VB.Label Item
      AutoSize        =  -1  'True
      BackColor      =  &H80000005&
      Caption        =  "Dette er en tom label."
      Height          =  195
      Index          =  0
      Left            =  0
      TabIndex        =  1
      Top            =  0
      Visible        =  0  'False
      Width          =  1935
      WordWrap        =  -1  'True
  End
End
Attribute VB_Name = "ListView"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

'  Internørd - ListView Control
' Code By:
'  Troels Windekilde - Internørd
'  December 16, 1999
'  E-mail: troels@winkill.dk
'  Web:    www.winkill.dk
'
' Any use of this code is at your own risk!

Private Const minWidth = 500
Private Const minHeight = 495
Private Const lineHeight = 195
Private Const borderSize = 30

Private selItem As Double

Private Sub Item_Click(Index As Integer)
    mrkItem selItem, False
    selItem = Index
    mrkItem Index, True
End Sub

Private Sub UserControl_Initialize()
    UserControl_Resize
End Sub

Private Sub UserControl_Resize()
    On Error GoTo Err_Fatal
    With UserControl
        If .Width < minWidth Then .Width = minWidth
        If .Height < minHeight Then .Height = minHeight
    End With
    VS.Left = -VS.Width
    With VScroll
        .Top = 0
        .Left = UserControl.Width - (borderSize * 2) - .Width
        .Height = UserControl.Height - (borderSize * 2)
        .Width = 255
        .Min = 1
        .Max = (HUntil(Item.UBound) + Item(Item.UBound).Height) / lineHeight
        If .Value > .Max Then .Value = .Max
        .LargeChange = ((UserControl.Height - (borderSize * 2)) / lineHeight) - 1
    End With
    With Item(0)
        .Width = UserControl.Width - (borderSize * 2)
        If VScroll.Visible Then .Width = .Width - VScroll.Width
    End With
    If Item.UBound > 0 Then
        Dim I As Double
        For I = 1 To Item.UBound
            With Item(I)
                .Top = HUntil(I) + ((VScroll.Value - 1) * -lineHeight)
                .Left = 0
                .Width = Item(0).Width
                .Visible = True
                .Refresh
            End With
            DoEvents
        Next I
    End If
Err_Fatal:
End Sub

Private Function HUntil(Index As Double) As Double
    Dim I As Double
    For I = 1 To Index - 1
        HUntil = HUntil + Item(I).Height
    Next I
End Function

Private Sub mrkItem(Index, Optional Sel As Boolean)
    On Error GoTo Err_Fatal
    If Sel Then
        With Item(Index)
            .BackColor = vbHighlight
            .ForeColor = vbHighlightText
        End With
    Else
        With Item(Index)
            .BackColor = vbWindowBackground
            .ForeColor = vbButtonText
        End With
    End If
Err_Fatal:
End Sub

' Public

Public Sub AddItem(Caption As String)
    Dim Index As Double
    Index = Item.UBound + 1
    Load Item(Index)
    Item(Index).Caption = Caption
    UserControl_Resize
End Sub

Public Property Get SelectedItem() As Double
    SelectedItem = selItem
End Property

Public Property Let SelectedItem(ByVal vNewValue As Double)
    mrkItem selItem, False
    selItem = vNewValue
    mrkItem selItem, True
End Property

Public Function Count() As Integer
    Count = Item.UBound
End Function

Private Sub VScroll_Change()
    UserControl_Resize
End Sub

Private Sub VScroll_Scroll()
    UserControl_Resize
End Sub

Her er yderligere tre Subs der kan tilføjes koden...

Public Sub Remove(Index As Double)
    Dim I As Double
    For I = Index To Item.UBound - 1
        Item(I).Caption = Item(I + 1).Caption
        Item(I).Refresh
    Next I
    Unload Item(Item.UBound)
End Sub

Public Sub Rename(Index As Double, NewCaption As String)
    Item(Index).Caption = NewCaption
    Item(Index).Refresh
End Sub

Public Sub SwapItems(Index1 As Double, Index2 As Double)
    Dim Tmp As String
    Tmp = Item(Index1).Caption
    Item(Index1).Caption = Item(Index2).Caption
    Item(Index2).Caption = Tmp
    Item(Index1).Refresh
    Item(Index2).Refresh
End Sub

Kan det ikke lade sig gøre at lave så man kan vælge det index man vil insætte på??
Altså lige som med ListView??

Eks.:

LSTView1.ListItems.Add(1, , "Line1") 'Indsert on line 1
LSTView1.ListItems.Add(2, , "Line2") 'Indsert on line 2

Det skal jeg bruge for at kunne bruge det til noget, da det er til en chat, hvor teksten kommer ind fra toppen..
Jeg skulle ligeledes helst ha' mulighed for at lægge farver på..

Hvis du kan lave det, skal jeg se hvad jeg kan gøre for at få flere points til dig.

Og JA...jps2mt@jps2mt.dk ER min E-Mail

/JPS2MT

Følgende sub er skrevet i Notepad, men den burde virke... Eller skal jeg nok rette den i VBA næste gang jeg kommer forbi en puter med Excel, Word eller Access.

Public Sub AddItem(Caption As String, Optional Index As Double)
    Dim Tmp As String, T As String
    If Not Index Then Index = Item.UBound + 1
    Load Item(Item.UBound + 1)
    Tmp = Item(Index).Caption
    Item(Index).Caption = Caption
    While Index < Item.UBound
        Index = Index + 1
        T = Item(Index).Caption
        Item(Index).Caption = Tmp
        Tmp = T
    Wend
    UserControl_Resize
End Sub

Det virker desværre ikke... :(

Ok, her er en der virker...

Public Sub AddItem(Caption As String, Optional Index As Double)
    Dim Tmp As String, T As String
    If Index < 1 Then Index = Item.UBound + 1
    Load Item(Item.UBound + 1)
    Tmp = Item(Index).Caption
    Item(Index).Caption = Caption
    While Index < Item.UBound
        Index = Index + 1
        T = Item(Index).Caption
        Item(Index).Caption = Tmp
        Tmp = T
    Wend
    UserControl_Resize
End Sub

Finder du ud af noget?

Jeg er lige flyttet, og er har ikke rigtigt fået kigget på det endnu...Måske en gang i næste uge...

Hvis du kan lave så jeg kan sætte farve efter eget valg på linierne (så der kan være forskellig farve pr. linie) så kan du få disse 15 points + 725 oveni...Men KUN hvis du får farven til at virke...

/JPS2MT

Hvis du mener en farve for hver Entry så ok, hvis det er for hver 'fysisk' linie så glæm det.

Dette er muligt.

---
blå
blå
---
rød
rød
---


Dette er ikke...
---
rød
blå
---
gul
---


Hvis du forstår hvad jeg mener...

Det er for hver "linie" jeg adder...Altså med hver additem entry, skal ha' sin egen farve...

For at det kan lade sig gøre skal mrkItem rettes til:

Private Sub mrkItem(Index, Optional Sel As Boolean)
    On Error GoTo Err_Fatal
    If Sel And .DataField <> "Sel" Then
        With Item(Index)
            .BackColor = vbHighlight
            .ForeColor = vbHighlightText
        End With
    ElseIf Not Sel And .DataField = "Sel"
        With Item(Index)
            .BackColor = vbWindowBackground
            .ForeColor = vbButtonText
        End With
    End If
Err_Fatal:
End Sub

Og så skal funktionen colorItem tilføjes:

Private Sub colorItem(Index, newBackColor, newForeColor)
    On Error GoTo Err_Fatal
    With Item(Index)
        .BackColor = newBackColor
        .ForeColor = newForeColor
    End With
Err_Fatal:
End Sub

Hvordan virker det så???

BTW. Det ser ud til at den mrkItm du skrev der ikke virker...Den melder i hvert fald fejl, når jeg vil køre noget med den Listview i...

Eks.:
colorItem(1, vbGreen, vbBlue)
' Første Item får grøn baggrund med blå tekst.
colorItem(2, vbGreen, vbRed)
' Andet Item får grøn baggrund med rød tekst.

Og så lige en rettelse mere til mrkItem...

Private Sub mrkItem(Index, Optional Sel As Boolean)
    On Error GoTo Err_Fatal
    If Sel Then
        Item(Index).DataField = "Sel"
    Else
        Item(Index).DataField = ""
    End If
    If Sel And Item(Index).DataField <> "Sel" Then
        With Item(Index)
            .BackColor = vbHighlight
            .ForeColor = vbHighlightText
        End With
    ElseIf Not Sel And Item(Index).DataField = "Sel"
        With Item(Index)
            .BackColor = vbWindowBackground
            .ForeColor = vbButtonText
        End With
    End If
Err_Fatal:
End Sub

Hmmm...Jeg kan ikke bruge colorItem...Er det ikke:

Listview1.colorItem man skal skrive???

Jo, hvis du ikke omdøber ListView1 så er det...

Listview1.colorItem(1, vbGreen, vbBlue)

..eller...

With ListView1
    .colorItem(1, vbGreen, vbBlue)
    .colorItem(2, vbGreen, vbBlue)
    .colorItem(3, vbGreen, vbBlue)
End With

Kan jeg ikke...Compile error...Expected =...

Aaargh, min fejl... Du skal ikke bruge parenteser... Dvs.:

Listview1.colorItem 1, vbGreen, vbBlue

..eller...

With ListView1
    .colorItem 1, vbGreen, vbBlue
    .colorItem 2, vbGreen, vbBlue
    .colorItem 3, vbGreen, vbBlue
End With

Den melder fejl på colorItem...

Compile error:

Method or data member not found

Ret Private til Public både i colorItem og mrkItem... ;)

    With ListView1
        .AddItem "Test1"
        .AddItem "Test2"
        .AddItem "Test3"
        .colorItem 1, vbGreen, vbBlue
        .colorItem 2, vbGreen, vbRed
        .colorItem 3, vbGreen, vbBlue
    End With

Shit, endnu en rettelse

Public Sub mrkItem(Index, Optional Sel As Boolean)
    Dim Tmp
    On Error GoTo Err_Fatal
    If Sel Then
        Item(Index).DataField = ""
    Else
        Item(Index).DataField = "Sel"
    End If
    If Sel And Item(Index).DataField <> "Sel" Then
        With Item(Index)
            Tmp = .BackColor
            .BackColor = .ForeColor
            .ForeColor = Tmp
        End With
    ElseIf Not Sel And Item(Index).DataField = "Sel" Then
        With Item(Index)
            Tmp = .BackColor
            .BackColor = .ForeColor
            .ForeColor = Tmp
        End With
    End If
Err_Fatal:
End Sub

Ved godt det er ved at blive lidt avanceret, men kan man lave sådan så den bevarer den farve en linie har, når der bliver indsat en ny i toppen???

Public Sub AddItem(Caption As String, Optional Index As Double)
    Static fC,bC,I
    Dim Tmp As String, T As String
    If Index < 1 Then Index = Item.UBound + 1
    Load Item(Item.UBound + 1)
    Tmp = Item(Index).Caption
    Item(Index).Caption = Caption
    I = 1
    If Index = 1 Then I = 2
    If Item.UBound > 0 Then
        Item(Index).BackColor = Item(I).BackColor
        Item(Index).ForeColor = Item(I).ForeColor
    End If
    While Index < Item.UBound
        Index = Index + 1
        T = Item(Index).Caption
        Item(Index).Caption = Tmp
        Tmp = T
    Wend
    UserControl_Resize
End Sub

Den melder fejl på den additem du har lavet nu...Det er noget med at det array '2' ikke findes...

Crap

Public Sub AddItem(Caption As String, Optional Index As Double)
    Static fC,bC,I
    Dim Tmp As String, T As String
    If Index < 1 Then Index = Item.UBound + 1
    Load Item(Item.UBound + 1)
    Tmp = Item(Index).Caption
    Item(Index).Caption = Caption
    If Item.UBound > 1 Then
        I = 1
        If Index = 1 Then I = 2
        Item(Index).BackColor = Item(I).BackColor
        Item(Index).ForeColor = Item(I).ForeColor
    End If
    While Index < Item.UBound
        Index = Index + 1
        T = Item(Index).Caption
        Item(Index).Caption = Tmp
        Tmp = T
    Wend
    UserControl_Resize
End Sub

Hvis ovenstående ikke virker så skift den ud med:

Public Sub AddItem(Caption As String, Optional Index As Double)
    Static fC,bC,I
    Dim Tmp As String, T As String
    If Index < 1 Then Index = Item.UBound + 1
    Load Item(Item.UBound + 1)
    Tmp = Item(Index).Caption
    Item(Index).Caption = Caption
    If Item.UBound > 1 Then
        If Index = 1 Then I = 1
        Item(Index).BackColor = Item(I).BackColor
        Item(Index).ForeColor = Item(I).ForeColor
    End If
    While Index < Item.UBound
        Index = Index + 1
        T = Item(Index).Caption
        Item(Index).Caption = Tmp
        Tmp = T
    Wend
    UserControl_Resize
End Sub

Den øverste laver farven fra index 2 til den farve der bliver brugt på 1 og 2...Men den 3. får bare default farve...

Den nederste laver bare det som den altdi har gjort...index'ene har en fast farve...Det var TEKSTEN i de index der skulle holde farven...

Dvs. hvis index 1 er rød, og man indsætter en ny tekst i index 1, så skal index 1 blive den farve man vælger, og index 2 den farve som den havde da den hed index 1...

(Det blev vist lidt indviklet... :-)

Så fjern Item(Index).BackColor = Item(I).BackColor fra Public Sub AddItem

Det giver INGEN forskel overhovedet...

Så forstår jeg ikke hvad du mener, find selv ud af det.