Manejo de listas, activa y desactiva controles, pasa datos una lista a otra, los acomoda, etc.
VERSION 5.00 Begin VB.Form Form4 BorderStyle = 1 'Fixed Single Caption = "Practica 4 - Manejo de listas" ClientHeight = 4980 ClientLeft = 1380 ClientTop = 1230 ClientWidth = 6255 LinkTopic = "Form1" MaxButton = 0 'False MinButton = 0 'False ScaleHeight = 4980 ScaleWidth = 6255 StartUpPosition = 2 'CenterScreen Begin VB.CommandButton last Caption = "Final" Enabled = 0 'False Height = 375 Left = 4800 TabIndex = 17 Top = 2400 Width = 1335 End Begin VB.CommandButton first Caption = "Inicio" Enabled = 0 'False Height = 375 Left = 4800 TabIndex = 16 Top = 960 Width = 1335 End Begin VB.CommandButton down Caption = "Down" Enabled = 0 'False Height = 375 Left = 4800 TabIndex = 15 Top = 1920 Width = 1335 End Begin VB.CommandButton up Caption = "Arriba" Enabled = 0 'False Height = 375 Left = 4800 TabIndex = 14 Top = 1440 Width = 1335 End Begin VB.CommandButton clear_all Caption = "Limpiar ambas listas" Height = 375 Left = 120 TabIndex = 13 Top = 3840 Width = 4455 End Begin VB.CommandButton clear_2 Caption = "Limpiar lista 2" Height = 375 Left = 2640 TabIndex = 12 Top = 3360 Width = 1935 End Begin VB.CommandButton clear_1 Caption = "Limpiar lista 1" Height = 375 Left = 120 TabIndex = 11 Top = 3360 Width = 1935 End Begin VB.OptionButton Option2 Caption = "lista 2" Height = 255 Left = 1200 TabIndex = 9 Top = 480 Width = 975 End Begin VB.OptionButton Option1 Caption = "lista 1" Height = 255 Left = 120 TabIndex = 8 Top = 480 Value = -1 'True Width = 975 End Begin VB.ListBox List2 BeginProperty Font Name = "Tahoma" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 2460 Left = 2640 TabIndex = 7 Top = 840 Width = 1935 End Begin VB.CommandButton l_all Caption = "<<" Height = 375 Left = 2160 TabIndex = 6 Top = 2400 Width = 375 End Begin VB.CommandButton l_one Caption = "<" Height = 375 Left = 2160 TabIndex = 5 Top = 1920 Width = 375 End Begin VB.CommandButton r_all Caption = ">>" Height = 375 Left = 2160 TabIndex = 4 Top = 1440 Width = 375 End Begin VB.CommandButton r_one Caption = ">" Height = 375 Left = 2160 TabIndex = 3 Top = 960 Width = 375 End Begin VB.CommandButton Command1 Caption = "Agregar" BeginProperty Font Name = "Tahoma" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 4920 TabIndex = 2 Top = 120 Width = 1215 End Begin VB.TextBox Text1 Height = 285 Left = 120 TabIndex = 1 Top = 120 Width = 4695 End Begin VB.ListBox List1 BeginProperty Font Name = "Tahoma" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 2460 ItemData = "practica4-modular.frx":0000 Left = 120 List = "practica4-modular.frx":0016 TabIndex = 0 Top = 840 Width = 1935 End Begin VB.Label Label1 AutoSize = -1 'True Height = 195 Left = 4920 TabIndex = 18 Top = 3000 Width = 45 End Begin VB.Label view Alignment = 2 'Center BeginProperty Font Name = "Tahoma" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00C00000& Height = 495 Left = 0 TabIndex = 10 Top = 4320 Width = 4695 End End Attribute VB_Name = "Form4" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Private Sub clear_1_Click() List1.Clear view.Caption = "" Call evaluar End Sub Private Sub clear_2_Click() List2.Clear view.Caption = "" Call evaluar End Sub Private Sub clear_all_Click() List1.Clear List2.Clear view.Caption = "" Call evaluar End Sub Private Sub Command1_Click() If Option1 = False And Option2 = False Then 'Si no se selecciono ninguna lista para meter el dato...' 'Y ya se esta intentando ingresar, mostrar un error y regresar' 'al formulario de nuevo' MsgBox "Error: No se selecciono una lista", vbCritical, "Warning" Else 'Cuando presionen el boton Agregar' If Text1.Text <> "" Then 'Evalua que no este en blanco' If Option1 = True Then 'LISTA1' List1.AddItem Text1.Text 'Lo agrega a la lista' Text1.Text = "" 'Regresa a blanco el cuadro de texto' '...la cantidad de registros de la lista' Else 'LISTA2' List2.AddItem Text1.Text Text1.Text = "" '...la cantidad de registros de la lista' End If End If End If Call evaluar End Sub Private Sub up_Click() MsgBox "Manda elemento posicion arriba" End Sub Private Sub down_Click() MsgBox "manda elemento posicion abajo" End Sub Private Sub first_Click() MsgBox "Manda elemento al inicio" End Sub Private Sub last_Click() MsgBox "manda elemento al final" End Sub Private Sub Form_Load() Call evaluar End Sub Private Sub form_click() List1.ListIndex = -1 List2.ListIndex = -1 lista1 = False lista2 = False Call evaluar End Sub Private Sub l_all_Click() For c = 0 To List2.ListCount - 1 List1.AddItem List2.List(c) Next For c = 0 To List2.ListCount - 1 List2.RemoveItem 0 Next Call evaluar End Sub Private Sub l_one_Click() If List2.ListIndex >= 0 Then List1.AddItem List2.List(List2.ListIndex) List2.RemoveItem List2.ListIndex view.Caption = "" End If Call evaluar End Sub Private Sub List1_Click() 'Cuando le dan click a la lista1...' '...muestra cual registros esta seleccionado' view.Caption = List1.List(List1.ListIndex) Call evaluar End Sub Private Sub List2_Click() 'Cuando le dan click a la lista2...' '...Muestra cual regist esta seleccionado' view.Caption = List2.List(List2.ListIndex) Call evaluar End Sub Private Sub Option1_Click() 'Si elije opcion 1, Se envia el dato a la lista 1' Dim lista As Integer If Option1 = True Then lista = 1 End If Call evaluar End Sub Private Sub Option2_Click() 'Si elije opcion 2, Se envia el dato a la lista 2' Dim lista As Integer If Option2 = True Then lista = 2 End If Call evaluar End Sub Private Sub r_all_Click() For c = 0 To List1.ListCount - 1 List2.AddItem List1.List(c) Next For c = 0 To List1.ListCount - 1 List1.RemoveItem 0 Next Call evaluar End Sub Private Sub r_one_Click() 'Mover de lista1 a lista2 un registro' If List1.ListIndex >= 0 Then List2.AddItem List1.List(List1.ListIndex) List1.RemoveItem List1.ListIndex view.Caption = "" End If Call evaluar End Sub Function evaluar() 'Evalua el formulario' If List1.ListCount = 0 Then r_one.Enabled = False r_all.Enabled = False clear_1.Enabled = False End If If List1.ListCount > 0 Then r_all.Enabled = True clear_1.Enabled = True clear_all.Enabled = True End If If List1.ListIndex = -1 Then r_one.Enabled = False lista1 = False 'lista1 desactivada End If If List1.ListIndex > -1 Then r_one.Enabled = True lista1 = True lista2 = False End If '''''''''''''''''''''''''' If List2.ListCount = 0 Then l_one.Enabled = False clear_2.Enabled = False l_all.Enabled = False End If If List2.ListCount > 0 Then l_all.Enabled = True clear_2.Enabled = True clear_all.Enabled = True End If If List2.ListIndex = -1 Then l_one.Enabled = False End If If List2.ListIndex > -1 Then l_one.Enabled = True lista1 = False lista2 = True End If '''''''''''''''''''''''''' If List1.ListCount = 0 And List2.ListCount = 0 Then clear_all.Enabled = False End If If lista1 = True And lista2 = False Then Label1.Caption = "Lista 1" Else Label1.Caption = "" End If If lista2 = True And lista1 = False Then Label1.Caption = "Lista 2" Else Label1.Caption = "" End If End Function Private Sub Text1_Change() Command1.Enabled = True Call evaluar End Sub
Este programa no tiene ejecucion ¿Has encontrado algún error? ¿Tienes la solución? Dejame tu correción ;-)
Antes de comentar: Gran parte de los ejercicios propuestos no tienen librerías debido a que Wordpress las eliminó al verlas como etiquetas HTML. Si sabes/tienes/conoces las librerías que hacen falta, déjalo en los comentarios. Y lo mas importante: Todos los ejemplos fueron realizados por personas con únicamente conocimiento básico del lenguaje, no de programación.
Otro punto importante: Si vas a sugerir un segmento de código en algún lenguaje debes hacerlo así:
- Si es lenguaje C [c]Código en C[/c]
- Si es lenguaje Pascal [pascal]Aquí dentro el código de Pascal[/pascal].
De esta manera el código coloreas el código.
Otro punto importante para muchos que sienten que se les ignora: Todos los comentarios los reviso y en su debido momento los apruebo, pero ojo con el con lo siguiente:Me reservo el derecho de alterar, publicar o no los comentarios as´ como cambiar mis condiciones en el momento que así lo requiera.
¿estas de acuerdo? entonces adelante que ya te he quitado bastante tiempo leyendo esta basura de advertencias :)