VERSION 5.00
Begin VB.UserControl ctrl_listarray 
   ClientHeight    =   1920
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   5580
   ScaleHeight     =   1920
   ScaleWidth      =   5580
   Begin VB.ListBox lst_disp 
      Height          =   1815
      ItemData        =   "ctrl_list.ctx":0000
      Left            =   0
      List            =   "ctrl_list.ctx":0002
      Sorted          =   -1  'True
      TabIndex        =   0
      Top             =   50
      Width           =   2295
   End
   Begin VB.ListBox lst_sel 
      Height          =   1815
      ItemData        =   "ctrl_list.ctx":0004
      Left            =   3240
      List            =   "ctrl_list.ctx":0006
      Sorted          =   -1  'True
      TabIndex        =   5
      Top             =   50
      Width           =   2295
   End
   Begin VB.CommandButton cmd_agregaritem 
      Caption         =   ">"
      Height          =   375
      Left            =   2350
      TabIndex        =   1
      Top             =   70
      Width           =   855
   End
   Begin VB.CommandButton cmd_agregartodos 
      Caption         =   ">>"
      Height          =   375
      Left            =   2350
      TabIndex        =   2
      Top             =   530
      Width           =   855
   End
   Begin VB.CommandButton cmd_quitaritem 
      Caption         =   "<"
      Height          =   375
      Left            =   2350
      TabIndex        =   3
      Top             =   990
      Width           =   855
   End
   Begin VB.CommandButton cmd_quitartodos 
      Caption         =   "<<"
      Height          =   375
      Left            =   2350
      TabIndex        =   4
      Top             =   1500
      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
'
'modificaciones : se agrego la opcion de recibir dos recordset
'fecha          :19/09
'autor          :gustavo duffoo
'
'modificaciones : se agrego la opcion de que uno de los recordset sea nothing
'fecha          :21/109
'autor          :gustavo duffoo
'
'modificaciones : se agrego la opcion de mostrar siempre un elemento seleccionados
'fecha          :26/09
'autor          :gustavo duffoo
'
'modificaciones : se agrego la opcion de cambiar el tamaño en filas
'fecha          : 27/09
'autor          :gustavo duffoo
'comentario     :debe agregarse la opcion de cambiar el tamaño del control en columnas
'
'modificaciones : se agrego la funcion de devolver una cadena con los codigos seleccioandos
'fecha          : 02/10
'autor          :gustavo duffoo
'
'modificaciones : se forzo la ordenacion en ambas listas
'fecha          : 14/10
'autor          :gustavo duffoo
'
'modificaciones : se AGREGO LA FUNCION DE CAMBIAR EL TAMAÑO EN COLUMNAS
'fecha          : 15/10
'autor          :gustavo duffoo

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)
    If lst_disp.ListCount > 0 Then
        If nl = 0 Then
            lst_disp.ListIndex = nl
        Else
            lst_disp.ListIndex = nl - 1
        End If
    End If
End If
End Sub

Private Sub cmd_agregartodos_Click()
Dim nl As Long
Dim nlin As Long
nlin = lst_disp.ListCount
If nlin >= 0 Then
    For nl = 0 To lst_disp.ListCount - 1
        lst_sel.AddItem (lst_disp.List(nl))
    Next
    lst_disp.Clear
    If nlin > 0 Then
        lst_sel.ListIndex = 0
    End If
End If
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)

    If lst_sel.ListCount > 0 Then
        If nl = 0 Then
            lst_sel.ListIndex = nl
        Else
            lst_sel.ListIndex = nl - 1
        End If
    End If
End If
End Sub

Private Sub cmd_quitartodos_Click()
Dim nl As Long
Dim nlin As Long
nlin = lst_sel.ListCount
If nlin >= 0 Then
    For nl = 0 To lst_sel.ListCount - 1
        lst_disp.AddItem (lst_sel.List(nl))
    Next
    lst_sel.Clear
    If nlin > 0 Then
        lst_disp.ListIndex = 0
    End If

End If
End Sub

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

Public Function llenar_matrizseleccionados() 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(1 To ne, 1 To 2)
For i = 1 To ne
    cade = lst_sel.List(i - 1)
    cade1 = Trim(Mid(cade, 1, InStr(cade, "=") - 151))
    cade2 = Trim(Mid(cade, InStr(cade, "=") + 1))
    tm1(i, 1) = cade2
    tm1(i, 2) = cade1
Next
llenar_matrizseleccionados = tm1
End Function

Private Sub lst_disp_DblClick()
Call cmd_agregaritem_Click
End Sub

Private Sub lst_disp_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
Call cmd_agregaritem_Click
End If
End Sub

Private Sub lst_sel_DblClick()
cmd_quitaritem_Click
End Sub

Public Sub size(filas As Integer, Optional COLUMNAS As Integer)
lst_disp.Height = filas * 180
lst_sel.Height = filas * 180
If COLUMNAS > 0 Then
    lst_disp.Width = COLUMNAS * 90
    
    cmd_agregaritem.Left = lst_disp.Width + 150
    cmd_agregartodos.Left = lst_disp.Width + 150
    cmd_quitaritem.Left = lst_disp.Width + 150
    cmd_quitartodos.Left = lst_disp.Width + 150
    lst_sel.Left = lst_disp.Width + cmd_agregaritem.Width + 300
    lst_sel.Width = COLUMNAS * 90
End If
End Sub

Public Function nseleccionados() As Integer
nseleccionados = lst_sel.ListCount
End Function

Public Function ndisponibles() As Integer
ndisponibles = lst_disp.ListCount
End Function

Public Function listar_codigos() As String
Dim i As Integer
Dim li_ne As Integer 'numero de elementos
Dim ls_cadena As String
Dim ls_temp As String
li_ne = lst_sel.ListCount
For i = 1 To li_ne
    ls_temp = lst_sel.List(i - 1)
    If i > 1 Then ls_cadena = ls_cadena + ","
    ls_cadena = ls_cadena + "'" + Trim(Mid(ls_temp, InStr(ls_temp, "=") + 1)) + "'"
Next
listar_codigos = ls_cadena
End Function

Public Function listar_codigos_disponibles() As String
Dim i As Integer
Dim li_ne As Integer 'numero de elementos
Dim ls_cadena As String
Dim ls_temp As String
li_ne = lst_disp.ListCount
For i = 1 To li_ne
    ls_temp = lst_disp.List(i - 1)
    If i > 1 Then ls_cadena = ls_cadena + ","
    ls_cadena = ls_cadena + "'" + Trim(Mid(ls_temp, InStr(ls_temp, "=") + 1)) + "'"
Next
listar_codigos_disponibles = ls_cadena
End Function

Public Function listar_codigos_seleccionados() As String
'se agrego por compatibilidad
'realiza la misma funcion que listar_codigos
Dim i As Integer
Dim li_ne As Integer 'numero de elementos
Dim ls_cadena As String
Dim ls_temp As String
li_ne = lst_sel.ListCount
For i = 1 To li_ne
    ls_temp = lst_sel.List(i - 1)
    If i > 1 Then ls_cadena = ls_cadena + ","
    ls_cadena = ls_cadena + "'" + Trim(Mid(ls_temp, InStr(ls_temp, "=") + 1)) + "'"
Next
listar_codigos_seleccionados = ls_cadena
End Function

Public Function llenar_matrizdisponibles() 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_disp.ListCount
ReDim tm1(1 To ne, 1 To 2)
For i = 1 To ne
    cade = lst_disp.List(i - 1)
    cade1 = Trim(Mid(cade, 1, InStr(cade, "=") - 151))
    cade2 = Trim(Mid(cade, InStr(cade, "=") + 1))
    tm1(i, 1) = cade2
    tm1(i, 2) = cade1
Next
llenar_matrizdisponibles = tm1
End Function
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
'existe por compatibilidad, fue reemplazara con la funcion llenar_matrizseleccionados
Dim tm1()
Dim i As Long
Dim ne As Long
Dim cade1, cade2, cade As String
ne = lst_sel.ListCount
ReDim tm1(ne, 2)
For i = 1 To ne
    cade = lst_sel.List(i - 1)
    cade1 = Trim(Mid(cade, 1, InStr(cade, "=") - 151))
    cade2 = Trim(Mid(cade, InStr(cade, "=") + 1))
    tm1(i, 1) = cade2
    tm1(i, 2) = cade1
Next
llenar_matriz = tm1
End Function
Private Sub lst_sel_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
    Call cmd_quitaritem_Click
End If
End Sub

'ADVERTENCIA: NO QUITAR NI MODIFICAR LAS SIGUIENTES LINEAS CON COMENTARIOS
'MappingInfo=UserControl,UserControl,-1,Enabled
Public Property Get Enabled() As Boolean
Attribute Enabled.VB_Description = "Devuelve o establece un valor que determina si un objeto puede responder a eventos generados por el usuario."
    Enabled = UserControl.Enabled
End Property

Public Property Let Enabled(ByVal New_Enabled As Boolean)
    UserControl.Enabled() = New_Enabled
    PropertyChanged "Enabled"
End Property

'Cargar valores de propiedad desde el almacén
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)

    UserControl.Enabled = PropBag.ReadProperty("Enabled", True)
End Sub

'Escribir valores de propiedad en el almacén
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    Call PropBag.WriteProperty("Enabled", UserControl.Enabled, True)
End Sub

