Entradas con la etiqueta ‘visual basic 6’

Ordenar el contenido de un listview númericamente y mover el scroll

Lunes, 8 de Septiembre de 2008

Para poder ordenar un listview tenemos la forma tradicional, mediante las propiedades:

Visual Basic:
  1. Dim indiceColumina as integer
  2.  
  3. indiceColumna=5
  4.  
  5. Listview.sorted=true
  6.  
  7. listview.sortkey= indiceColumna
  8.  
  9. listview.sortOrder=1  '0: ordenar ascedente,   1: ordenar descendente

El problema que la ordenación de este control es únicamente para string's, asi que si queremos ordenar por un número o identificador.

Es necesario volver a ordenar cada vez que añadimos un elemento al listview, así llamaramos cada vez que añadamos a la llamada a sistema.

Además si queremos conseguir que el primer elemento quede marcado al principio o al final. El scroll he probado de usar llamdas a sistema con LVM_SCROLL pero no funcinaba, finalmente he decidio seleccionar el elemento. Así para forzar ver el ultimo o primer elemento despues de ordenar: tan solo tendremos que hacer:

Visual Basic:
  1. ListView.ListItems.Item(ListView2.ListItems.Count - 1).Selected = True ' ultimo elemento
  2.  
  3. ListView.ListItems.Item(1).Selected = True ' primer elemento del listview, ' para subir el cursor arriba

Para  llamar a que se ordene despues de añadir sería así:

Visual Basic:
  1. '------ Mandamos a ordenar el listview. --------
  2. sOrder = 0 ' orden descendente ' 1 orden ascendente
  3. INDICE_COLUMNA_ELEMENTO = 5 ' definimos la columna por la que queremos ordenar
  4. ListView2.Sorted = False
  5. SendMessage2 ListView2.hwnd, _
  6. LVM_SORTITEMS, _
  7. ListView2.hwnd, _
  8. ByVal FARPROC(AddressOf CompareValues)
  9.  
  10. ' para subir el cursor arriba y ver el ultimo elmento añadido al listview
  11. ListView2.ListItems.Item(1).Selected = True
  12.  
  13. '------------------------------------------------------

Para conseguir ordenar usaremos el siguiente código (llamada a sistema) Tambien sirve para ordenar Fechas:

Visual Basic:
  1. '--------------------------- ORDEN DEL LISTVIEW NUMERICO Y FECHAS--------------
  2.  
  3. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  4. ' Copyright ©1996-2008 VBnet, Randy Birch, All Rights Reserved.
  5. ' Some pages may also contain other copyrights by the author.
  6.  
  7. 'controlzeta.net modificaciones :P
  8. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  9. ' Distribution: You can freely use this code in your own
  10. '               applications, but you may not reproduce
  11. '               or publish this code on any web site,
  12. '               online service, or distribute as source
  13. '               on any media without express permission.
  14. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  15.  
  16. Public objFind As LV_FINDINFO
  17. Public objItem As LV_ITEM
  18. Public INDICE_COLUMNA_ELEMENTO As Integer
  19.  
  20. 'variable to hold the sort order (ascending or descending)
  21. Public sOrder As Boolean
  22.  
  23. Public Type POINTAPI
  24. X As Long
  25. Y As Long
  26. End Type
  27.  
  28. Public Type LV_FINDINFO
  29. flags As Long
  30. psz As String
  31. lParam As Long
  32. pt As POINTAPI
  33. vkDirection As Long
  34. End Type
  35.  
  36. Public Type LV_ITEM
  37. mask As Long
  38. iItem As Long
  39. iSubItem As Long
  40. state As Long
  41. stateMask As Long
  42. pszText As String
  43. cchTextMax As Long
  44. iImage As Long
  45. lParam As Long
  46. iIndent As Long
  47. End Type
  48.  
  49. 'Constants
  50. Public Const LVFI_PARAM As Long = &H1
  51. Public Const LVIF_TEXT As Long = &H1
  52.  
  53. Public Const LVM_FIRST As Long = &H1000
  54. Const LVM_SCROLL = (LVM_FIRST + 20) ' extraña
  55.  
  56. Public Const LVM_FINDITEM As Long = (LVM_FIRST + 13)
  57. Public Const LVM_GETITEMTEXT As Long = (LVM_FIRST + 45)
  58. Public Const LVM_SORTITEMS As Long = (LVM_FIRST + 48) 'API declarations
  59.  
  60. Private Declare Function SendMessage3 Lib "user32" Alias "SendMessageA" (ByVal _
  61. hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
  62. lParam As Any) As Long
  63.  
  64. 'Declarada en InputEx le he tenido que cambiar a sendMessage2
  65. Public Declare Function SendMessage2 Lib "user32" _
  66. Alias "SendMessageA" _
  67. (ByVal hwnd As Long, _
  68. ByVal wMsg As Long, _
  69. ByVal wParam As Long, _
  70. lParam As Any) As Long
  71.  
  72. Public Function CompareDates(ByVal lParam1 As Long, _
  73. ByVal lParam2 As Long, _
  74. ByVal hwnd As Long) As Long
  75.  
  76. 'CompareDates: This is the sorting routine that gets passed to the
  77. 'ListView control to provide the comparison test for date values.
  78.  
  79. 'Compare returns:
  80. ' 0 = Less Than
  81. ' 1 = Equal
  82. ' 2 = Greater Than
  83.  
  84. Dim dDate1 As Date
  85. Dim dDate2 As Date
  86.  
  87. 'Obtain the item names and dates corresponding to the
  88. 'input parameters
  89. dDate1 = ListView_GetItemDate(hwnd, lParam1)
  90. dDate2 = ListView_GetItemDate(hwnd, lParam2)
  91.  
  92. 'based on the Public variable sOrder set in the
  93. 'ColumnHeader click sub, sort the dates appropriately:
  94. Select Case sOrder
  95. Case True 'sort descending
  96.  
  97. If dDate1 <dDate2 Then
  98. CompareDates = 0
  99. ElseIf dDate1 = dDate2 Then
  100. CompareDates = 1
  101. Else
  102. CompareDates = 2
  103. End If
  104.  
  105. Case Else 'sort ascending
  106.  
  107. If dDate1> dDate2 Then
  108. CompareDates = 0
  109. ElseIf dDate1 = dDate2 Then
  110. CompareDates = 1
  111. Else
  112. CompareDates = 2
  113. End If
  114.  
  115. End Select
  116.  
  117. End Function
  118.  
  119. Public Function CompareValues(ByVal lParam1 As Long, _
  120. ByVal lParam2 As Long, _
  121. ByVal hwnd As Long) As Long
  122.  
  123. 'CompareValues: This is the sorting routine that gets passed to the
  124. 'ListView control to provide the comparison test for numeric values.
  125.  
  126. 'Compare returns:
  127. ' 0 = Less Than
  128. ' 1 = Equal
  129. ' 2 = Greater Than
  130.  
  131. Dim val1 As Long
  132. Dim val2 As Long
  133.  
  134. 'Obtain the item names and values corresponding
  135. 'to the input parameters
  136. val1 = ListView_GetItemValueStr(hwnd, lParam1)
  137. val2 = ListView_GetItemValueStr(hwnd, lParam2)
  138.  
  139. 'based on the Public variable sOrder set in the
  140. 'columnheader click sub, sort the values appropriately:
  141. Select Case sOrder
  142. Case True 'sort descending
  143.  
  144. If val1 <val2 Then
  145. CompareValues = 0
  146. ElseIf val1 = val2 Then
  147. CompareValues = 1
  148. Else
  149. CompareValues = 2
  150. End If
  151.  
  152. Case Else 'sort ascending
  153.  
  154. If val1> val2 Then
  155. CompareValues = 0
  156. ElseIf val1 = val2 Then
  157. CompareValues = 1
  158. Else
  159. CompareValues = 2
  160. End If
  161.  
  162. End Select
  163.  
  164. End Function
  165.  
  166. Public Function ListView_GetItemDate(hwnd As Long, lParam As Long) As Date
  167.  
  168. Dim hIndex As Long
  169. Dim r As Long
  170.  
  171. 'Convert the input parameter to an index in the list view
  172. objFind.flags = LVFI_PARAM
  173. objFind.lParam = lParam
  174. hIndex = SendMessage(hwnd, LVM_FINDITEM, -1, objFind)
  175.  
  176. 'Obtain the value of the specified list view item.
  177. 'The objItem.iSubItem member is set to the index
  178. 'of the column that is being retrieved.
  179. objItem.mask = LVIF_TEXT
  180. objItem.iSubItem = INDICE_COLUMNA_ELEMENTO
  181. objItem.pszText = Space$(32)
  182. objItem.cchTextMax = Len(objItem.pszText)
  183.  
  184. 'get the string at subitem 1
  185. 'and convert it into a date and exit
  186. r = SendMessage(hwnd, LVM_GETITEMTEXT, hIndex, objItem)
  187. If r> 0 Then
  188. ListView_GetItemDate = CDate(Left$(objItem.pszText, r))
  189. End If
  190.  
  191. End Function
  192.  
  193. Public Function ListView_GetItemValueStr(hwnd As Long, lParam As Long) As Long
  194.  
  195. Dim hIndex As Long
  196. Dim r As Long
  197.  
  198. 'Convert the input parameter to an index in the list view
  199. objFind.flags = LVFI_PARAM
  200. objFind.lParam = lParam
  201. hIndex = SendMessage(hwnd, LVM_FINDITEM, -1, objFind)
  202.  
  203. 'Obtain the value of the specified list view item.
  204. 'The objItem.iSubItem member is set to the index
  205. 'of the column that is being retrieved.
  206. objItem.mask = LVIF_TEXT
  207. objItem.iSubItem = INDICE_COLUMNA_ELEMENTO
  208. objItem.pszText = Space$(32)
  209. objItem.cchTextMax = Len(objItem.pszText)
  210.  
  211. 'get the string at subitem
  212. 'and convert it into a long
  213. r = SendMessage(hwnd, LVM_GETITEMTEXT, hIndex, objItem)
  214. If r> 0 Then
  215. ListView_GetItemValueStr = CLng(Left$(objItem.pszText, r))
  216. End If
  217.  
  218. End Function
  219.  
  220. Public Function FARPROC(ByVal pfn As Long) As Long
  221.  
  222. 'A procedure that receives and returns
  223. 'the value of the AddressOf operator.
  224. 'This workaround is needed as you can't assign
  225. 'AddressOf directly to an API when you are also
  226. 'passing the value ByVal in the statement
  227. '(as is being done with SendMessage)
  228.  
  229. FARPROC = pfn
  230.  
  231. End Function
  232. ' ------------------------------- FIN CODIGO ORDEN LISTVIEW --------------------

fuente original

Error Visual basic 6 Runtime error 7 por culpa de “Microsoft Forms 2.0 Object library” (FM20.DLL)

Lunes, 1 de Septiembre de 2008

Una aplicacion de vb 6 que funcionaba correctamente, me toca reinstalar el windows por uno original y pumm.  La aplicación al iniciar lanza un error 7, memoria insuficiente (Error 7, Memoria insuficiente) o en ingles: "Out of Memory, runtime error 7".

Me he puesto a registar los dll's necesarios para el programa y todos bien.  mediante el comando regsrv32, en este caso:

  • regsvr32 C:\mdu\VBMySQLDirect.dll -> Myslq conector
  • regsvr32 C:\mdu\Mscomctl.ocx
  • regsvr32 C:\mdu\COMCTL32.OCX
  • regsvr32 C:\mdu\FM20.DLL  -> menu desplegables con autocompletado -> EL PROBLEMA!
  • regsvr32 C:\mdu\ImageWeb.ocx -> gif animados

El error seguia... El problema en mi caso, venia por usar un componente en el proyecto del tipo: Microsoft Forms 2.0 Object library", este component contenido en su dll FM20.DLL correctamente en la carpeta del programa y registrado sin problemas, resulta que no es capaz de funcionar sin el OFFICE... Así que el causante de todo esto es un bug de este componente que no es capaz decir nada mas que : "RUNTIME ERROR 7: Out of Memory".

El programa en cuestion usaba este componente para hacer una imitación a un suggest en un combobox. Que ahora he sustituido por una función de autoCompletado sin usar nada mas que cuatro porciones de código:

Visual Basic:
  1. ' Una variable en las declaraciones del formulario que contiene el combo:
  2.  
  3. Private Backspaced as As Boolean
  4.  
  5. 'una funcion que puedes poner en un modulo, o en las declaraciones del form , es la encargada de autocompletar
  6.  
  7. Public Function AutoCompletadoCombo(ctlComboBox As Control)
  8. '--------- <<Called from the _Change event of cboComboBox>> ----------------
  9. ' -- autor: http://vbasic.astalaweb.com/C_ComboBox/1_Combobox.asp -------
  10.  
  11. Dim i%, intSel%  ' % is a "shorthand" for Integers
  12.  
  13. 'If this fires in response to a Backspace or Delete, then
  14. 'Exit the function because then you wouldn't be able to backup:
  15. Select Case (Backspaced Or Len(ctlComboBox .Text) = 0)
  16. Case True: Backspaced = False: Exit Function
  17. End Select
  18.  
  19. With ctlComboBox
  20. 'Run through the available items in a For...Loop and grab
  21. 'the first one that matches the selection:
  22. For i = 0 To .ListCount - 1
  23. If InStr(1, .List(i), .Text, vbTextCompare) = 1 Then
  24. intSel = .SelStart
  25. .Text = .List(i)
  26. .SelStart = intSel
  27. .SelLength = Len(.Text) - intSel
  28. Exit For
  29.  
  30. End If
  31. Next i
  32. End With
  33.  
  34. End Function
  35.  
  36. ' Y en el evento KEYDOWN del control combo_box
  37. Select Case KeyCode
  38. Case vbKeyBack, vbKeyDelete 'if the Backspace or Delete key is pressed...
  39. Select Case Len(NOMBRE_DEL_COMBOBOX.Text)
  40. Case Is <> 0 '...and if the cboComboBox has text, then
  41. Backspaced = True  'set this to True
  42.  
  43. End Select
  44. End Select
  45.  
  46. ' para activarlo en el evento Change del <strong>combobox </strong>es necesario llamar a la funciona de autocompletado:
  47.  
  48. AutoCompletadoCombo nombreDelComboBox

un ejemplo sencillo para descargar

Al ejemplo le faltaba que fuera correctamente la propiedad listindex del combo, la que yo utilizaba, asi que tuve que modificar unas lineas para conseguirlo. Si alquien lo pide lo posteare...

Con este sencillo codigo tenemos un control combo box normal convertido en un suggest con el contenido de el. Adios al componente  Microsoft Forms 2.0 object Library y a las dependencias del programa a tener instalado Microsfot office! Todo por instalar OpenOfice :P  vaya dia!

Ajustar el texto de una columna de un control listview en visual basic 6

Viernes, 29 de Agosto de 2008

Para poder ajustar toas las columnas de un listview al tamaño del texto que contenga, podremos utilizar la siguiente funcion de vb:

Visual Basic:
  1. Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
  2. (ByVal hwnd As Long, _
  3. ByVal wMsg As Long, _
  4. ByVal wParam As Long, _
  5. lParam As Any) As Long
  6.  
  7. Private Sub AutosizeColumns(ByVal TargetListView As ListView)
  8.  
  9. Const SET_COLUMN_WIDTH  As Long = 4126
  10. Const AUTOSIZE_USEHEADER As Long = -2
  11.  
  12. Dim lngColumn As Long
  13.  
  14. For lngColumn = 0 To (TargetListView.ColumnHeaders.Count - 1)
  15.  
  16. Call SendMessage(TargetListView.hwnd, _
  17. SET_COLUMN_WIDTH, _
  18. lngColumn, _
  19. ByVal AUTOSIZE_USEHEADER)
  20.  
  21. Next lngColumn
  22.  
  23. End Sub

Para llamarlo tansolo invocarlo de esta forma:

Visual Basic:
  1. Call AutosizeColumns(ListView1)  ' alinea el listview

No es posible declarar la funcion privada en un módulo de codigo independiente, así que es necesario ponerlo en las declaracions del propio objeto form, donde este el listview

script obtenido en binaryWorld

Existe otra función que nos permite ajustar el column with de un listview por cada columna independientemente, a podeis ir a  ver en : ajustar listview

Conectar automaticamente una unidad de red en windows desde visual basic VB 6

Jueves, 7 de Agosto de 2008

Hoy tenemos una aplicación sobre windows XP Home, que guarda documentos en un servidor linux con una carpeta compartida sobre samba con permisos de usuario.

Necestamos que esta carpeta de red esté siempre conectada cuando el programa va a guardar los documentos. el problema es que windows xp no sabe recordar la contraseña con un usuario distinto al que nos logeamos en windows al entrar.

Así que desde nuestra aplicación en visual basic 6 vamos ha lazar un comando a la shell, para forzar a conectar la unidad de red.

El comando es de msdos NET USE. Para conectar con otro usuario se utiliza el parametro "/USER:" Veamos unos ejemplos:

NET USE letraUnidad:\\IP_DEL_SERVIDOR\CarpetaElegida  contraseña  /USER:nombreDelUsuario

NET USE E: \\192.168.1.100\MiCarpetaElegida   MiContraseña  /USER:MiNombreDeUsuario

Para utilizarlo invocar esta instrucción desde Visual Basic 6, tan solo tendremos que usar el comando shell:

shell('NET USE J: \\192.168.1.100\CarpetaElegida   contraseña  /USER:nombreDelUsuario')

De este modo habremos conectado automáticamente una unidad de red, sin tener que escribir siempre la contraseña, ademas teniendo la seguridad que estará disponible la unidad de red.

Si tenemos el mismo problema, pero no tenemos acceso al código del programa, podríamos hacer un archivo nuevo ejecutable del tipo miArchivo.bat, escribir la frase "NET USE ..." dentro de él y Luego tan solo copiar un acceso directo en la carpeta INICIO del menu inicio y cada vez que se encienda el ordenador, se ejecutará el archivo .bat conectándonos la Unidad de red. Este sistema es bastante menos seguro, pues cualquiera puede editar este fichero y ver nuestra contraseña. Además de este modo se abré la tipica ventana de consola que al instante se cierra. Si no se quiere poner en el menú inicio el acceso directo, se podría añadir en el registro de windows, mediante regedit, dentro de la variable Run que econtramos en: "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run"

De este modo automaticamente se lanzará el archivo ejecutable que conecta la unidad de red, al iniciar windows.

Paso a paso para principiantes para registrar el archivo .bat en el regisro de windows:

  1. clicamos sobre le menú inicio y damos a ejecutar
  2. escribimos regedit y pulsamos intro
  3. desplegamos HKEY_LOCAL_MACHINE\
  4. desplegamos Software\
  5. desplegamos Microsoft\
  6. desplegamos Windows\
  7. desplegamos CurrentVersion\
  8. clicamos sobre  Run\
  9. Ahora la parte de mano derecha hacemos botón derecho Nuevo y Valor Alfa numérico
  10. Le ponemos el nombre que queramos .
  11. hacemos doble click sobre el nuevo valor Alfanumérico añadido y podremos añadir la ruta donde esté nuestro archivo ejecutable. (C://carpeta/otraCarpeta/miArchivo.bat)