Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Listview2
Message
From
22/04/2002 10:42:38
 
 
To
22/04/2002 08:38:12
General information
Forum:
Visual Basic
Category:
Database DAO/RDO/ODBC/ADO
Title:
Miscellaneous
Thread ID:
00647476
Message ID:
00647544
Views:
13
Sorry but i have a problem again with listview, if the usrs insert only the first 2 letters of a field doesnt work. Can you help.
I'm becoming very boring....
Sorry

if you can dispend some time searching for my mistake a owe you one!
I give the code of the form tha contains the list view:

Option Explicit

Private Sub BtnEditar_Click()
LviewClientes_DblClick
End Sub

Private Sub BtnNovo_Click()
MnuNovo_click
End Sub

Private Sub Command1_Click()
MnuFechar_Click
End Sub

Private Sub Form_Load()

ModUtils.CentraFormFilha MdiMenu, Me
LviewClientes.Top = 0
LviewClientes.Left = 0

ParametrizarLviewClientes

ListarRsClientes

ModVarsGlobais.CORRER_NOVAMENTE_FORM_LOAD = True

End Sub

Private Sub Form_Activate()

Dim PrimeiroItem As ListItem


If (ModVarsGlobais.CORRER_NOVAMENTE_FORM_LOAD = True) Then

Form_Load

End If

Set PrimeiroItem = LviewClientes.GetFirstVisible

If Not (PrimeiroItem Is Nothing) Then

PrimeiroItem.EnsureVisible
PrimeiroItem.Selected = True

ModVarsGlobais.CODIGO_CLIENTE = CDbl(PrimeiroItem.Text)

Else

ModVarsGlobais.CODIGO_CLIENTE = ModVarsGlobais.CLIENTE_INDEFINIDO

DesactivaMenuPopUpListagem


End If

End Sub

Private Sub ParametrizarLviewClientes()
Dim i As Integer
Dim LviewItem As ListItem

' Configuração da Lview
With LviewClientes
.View = lvwReport
.GridLines = False
.FullRowSelect = True
.BorderStyle = ccNone
.LabelEdit = lvwManual
.SortOrder = lvwAscending
.Sorted = True
End With

' Headers das Colunas
With LviewClientes.ColumnHeaders
.Add , , " Cód", 800, lvwColumnLeft
.Add , , " Nome", 3500, lvwColumnLeft
.Add , , "Telefone ", 1300, lvwColumnRight
.Add , , "Fax ", 1300, lvwColumnRight
.Add , , "Nr.Contribuinte ", 2000, lvwColumnRight
.Add , , " Email", 4000, lvwColumnLeft
End With
End Sub

Private Sub ListarRsClientes()

Dim LviewItem As ListItem

On Error GoTo ERRO_ACESSO_RECORDSET

LviewClientes.ListItems.Clear

DtaEnvBD.rsTabClientes.Open

DtaEnvBD.rsTabClientes.MoveFirst


While Not DtaEnvBD.rsTabClientes.EOF

Set LviewItem = LviewClientes.ListItems.Add(, , DtaEnvBD.rsTabClientes.Fields("NCliente"))

LviewItem.SubItems(1) = DtaEnvBD.rsTabClientes.Fields("Nome")

If Not IsNull(DtaEnvBD.rsTabClientes.Fields("Telefone")) Then

LviewItem.SubItems(2) = DtaEnvBD.rsTabClientes.Fields("Telefone")

Else

LviewItem.SubItems(2) = ""

End If

If Not IsNull(DtaEnvBD.rsTabClientes.Fields("Fax")) Then

LviewItem.SubItems(3) = DtaEnvBD.rsTabClientes.Fields("Fax")

Else

LviewItem.SubItems(3) = ""

End If

If Not IsNull(DtaEnvBD.rsTabClientes.Fields("Cont")) Then

LviewItem.SubItems(4) = DtaEnvBD.rsTabClientes.Fields("Cont")

Else

LviewItem.SubItems(4) = ""

End If

If Not IsNull(DtaEnvBD.rsTabClientes.Fields("Mail")) Then

LviewItem.SubItems(5) = DtaEnvBD.rsTabClientes.Fields("Mail")

Else

LviewItem.SubItems(5) = ""

End If


DtaEnvBD.rsTabClientes.MoveNext
Wend

DtaEnvBD.rsTabClientes.Close


CONTINUAR_SUB:
Exit Sub

ERRO_ACESSO_RECORDSET:
Resume CONTINUAR_SUB

End Sub

Private Sub Form_Unload(Cancel As Integer)
MdiMenu.TbarMDI.Enabled = True

End Sub


Private Sub LviewClientes_DblClick()
FrmClientes.Show

End Sub

Private Sub LviewClientes_ItemClick(ByVal Item As MSComctlLib.ListItem)

ModVarsGlobais.CODIGO_CLIENTE = CDbl(Item.Text)


End Sub

Private Sub LviewClientes_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

Dim Item As ListItem

If Button = vbRightButton Then

Set Item = LviewClientes.HitTest(X, Y)

If (Item Is Nothing) Then

MnuCopiar.Enabled = False

Else

MnuCopiar.Enabled = True

LviewClientes_ItemClick Item

Item.EnsureVisible
Item.Selected = True

End If

PopupMenu MnuPopUpListagem

End If


End Sub

Private Sub LviewClientes_ColumnClick(ByVal ColumnHeader As ColumnHeader)

LviewClientes.SortKey = ColumnHeader.SubItemIndex

LviewClientes.Sorted = True

Select Case LviewClientes.SortOrder

Case lvwDescending
LviewClientes.SortOrder = lvwAscending

Case Else
LviewClientes.SortOrder = lvwDescending

End Select

End Sub


Private Sub DesactivaMenuPopUpListagem()

MnuProcurar.Enabled = False

MnuCopiar.Enabled = False

MnuFechar.Enabled = False

End Sub

'This is the part of the code where i start the search
Private Sub MnuProcurar_Click()

Dim ItemAProcurar As ListItem


Set ItemAProcurar = LviewClientes.FindItem(InputBox("Introduza o Item a Pesquisar?", "Procurar", "", Me.ScaleWidth / 3, Me.Height / 2), lvwText, , lvwPartial)

If (ItemAProcurar Is Nothing) Then
MsgBox "Item Não Encontrado!", vbInformation, "Info"

Else
ItemAProcurar.EnsureVisible

ItemAProcurar.Selected = True

LviewClientes.SetFocus

End If

End Sub
Private Sub MnuCopiar_Click()

Dim ItemAProcurar As ListItem

Dim i As Integer

Dim InfoClipBoard As String


Set ItemAProcurar = LviewClientes.FindItem(CStr(ModVarsGlobais.CODIGO_CLIENTE), lvwText)


InfoClipBoard = ItemAProcurar.Text

For i = 1 To ItemAProcurar.ListSubItems.Count
InfoClipBoard = InfoClipBoard & vbTab & ItemAProcurar.SubItems(i)
Next i

Clipboard.SetText InfoClipBoard

End Sub

Private Sub MnuFechar_Click()

Unload Me

End Sub

Private Sub MnuNovo_click()
DtaEnvBD.rsTabClientes.Open
FrmClientes.BtnAdicionar_Click
End Sub

Sorry again... ... ...
Previous
Next
Reply
Map
View

Click here to load this message in the networking platform