VERSION 5.00
Begin VB.UserControl ctrl_listarray 
   ClientHeight    =   2145
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   5880
   ScaleHeight     =   2145
   ScaleWidth      =   5880
   Begin VB.ListBox lst_disp 
      Height          =   1815
      Left            =   120
      Sorted          =   -1  'True
      TabIndex        =   5
      Top             =   120
      Width           =   2295
   End
   Begin VB.ListBox lst_sel 
      Height          =   1815
      Left            =   3480
      TabIndex        =   4
      Top             =   120
      Width           =   2295
   End
   Begin VB.CommandButton cmd_agregaritem 
      Caption         =   ">"
      Height          =   375
      Left            =   2520
      TabIndex        =   3
      Top             =   240
      Width           =   855
   End
   Begin VB.CommandButton cmd_agregartodos 
      Caption         =   ">>"
      Height          =   375
      Left            =   2520
      TabIndex        =   2
      Top             =   720
      Width           =   855
   End
   Begin VB.CommandButton cmd_quitaritem 
      Caption         =   "<"
      Height          =   375
      Left            =   2520
      TabIndex        =   1
      Top             =   1200
      Width           =   855
   End
   Begin VB.CommandButton cmd_quitartodos 
      Caption         =   "<<"
      Height          =   375
      Left            =   2520
      TabIndex        =   0
      Top             =   1680
      Width           =   855
   End
End
Attribute VB_Name = "ctrl_listarray"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
'control ctrl_listarray
'autor  : gustavo duffoo
'fecha:  10/09/2002 10:00 am
'parametros de entrada  :
'un recordset de los cuales tomara los dos primeros campos
'el primero campo debe ser el codigo y el segundo la descripcion
'tomara el segundo campo para llenar la lista de elementos disponibles
'devolvera una matriz de 2 columnas con los valores seleccionados
Private Sub cmd_agregaritem_Click()
Dim nl As Long
nl = lst_disp.ListIndex
If nl >= 0 Then
    lst_sel.AddItem (lst_disp.List(nl))
    lst_disp.RemoveItem (lst_disp.ListIndex)
End If
End Sub

Private Sub cmd_agregartodos_Click()
Dim nl As Long
For nl = 0 To lst_disp.ListCount - 1
    lst_sel.AddItem (lst_disp.List(0))
    lst_disp.RemoveItem 0
Next
End Sub

Private Sub cmd_quitaritem_Click()
Dim nl As Long
nl = lst_sel.ListIndex
If nl >= 0 Then
    lst_disp.AddItem (lst_sel.List(nl))
    lst_sel.RemoveItem (lst_sel.ListIndex)
End If
End Sub

Private Sub cmd_quitartodos_Click()
Dim nl As Long
For nl = 0 To lst_sel.ListCount - 1
    lst_disp.AddItem (lst_sel.List(0))
    lst_sel.RemoveItem 0
Next

End Sub

Public Sub llena_lista(rs As ADODB.Recordset, Optional rs2 As ADODB.Recordset)
Dim s As String
Dim s2
lst_disp.Clear
lst_sel.Clear
If Not rs.EOF Then
    rs.MoveFirst
    Do Until rs.EOF
      s2 = rs.Fields(0)
       If IsNumeric(s2) Then
        s2 = Str(s2)
        End If
       s = rs.Fields(1) + Space(50) + "=" + s
       lst_disp.AddItem (s)
       rs.MoveNext
    Loop
End If
If rs2 Is Nothing Then      'llego solo un rs, se llena todo el list disponibles
    MsgBox ("no llego") ' y solo se llenan en disponibles los que no esten en sel
Else
    If Not rs2.EOF Then
        rs2.MoveFirst
        Do Until rs2.EOF
            If IsNumeric(s2) Then
                s2 = Str(s2)
            End If
            s = rs2.Fields(1) + Space(50) + "=" + s
            lst_sel.AddItem (s)
            rs2.MoveNext
         Loop
    End If
End If
End Sub

Public Function llenar_matriz() As Variant
' funcionabilidad :'se usara para llenar una matriz con los elementos seleccionados
'autor  : gustavo duffoo
'fecha:  10/09/2002 10:00 am
'valor de retorno: matriz con los elementos seleccionados

Dim tm1()
Dim i As Long
Dim ne As Long
Dim cade1, cade2, cade As String
ne = lst_sel.ListCount
ReDim tm1(ne + 1, 2)
For i = 1 To ne
    cade = lst_sel.List(i - 1)
    cade1 = Mid(cade, 1, InStr(cade, "=") - 50)
    cade2 = Mid(cade, InStr(cade, "=") + 1)
    tm1(i, 1) = cade2
    tm1(i, 2) = cade1
Next
llenar_matriz = tm1
End Function

Private Sub lst_disp_DblClick()
cmd_agregaritem_Click
End Sub

Private Sub lst_sel_DblClick()
cmd_quitaritem_Click
End Sub

