Foro de elhacker.net

Programación => Programación Visual Basic => Mensaje iniciado por: Orellanack en 3 Octubre 2013, 17:38 pm


Título: Cambiar fuente a un item de ComboBox
Publicado por: Orellanack en 3 Octubre 2013, 17:38 pm

Buen dia!

Estoy generando un codigo en el cual necesito que cambie el color de la fuente de un item de un ComboBox el cual esta cargado con datos de una base en excel.

(http://C:\Users\recepcionbaseandina\Desktop\123.jpg)

Esta es la base que tengo. Tengo un formulario de registro en VB para alimentar esta BD. Para que no se repita el horario de ingreso y entrega en la misma area de trabajo hago que se comparen las fechas, luego de clasificar las que son iguales busco las areas de trabajo que se repiten e imprimo los datos de hora de ingreso y hora de entrega en un ListBox. (Hasta aqui ya lo tengo listo). Ahora, tengo 2 ComboBox. Estos dos los cargo con horas en intervalos de 0:30 min. desde 00:00 hasta 24:00. Lo que quiero es verificar en la base de datos la hora de ingreso del area de trabajo y la hora de entrega del mismo dia.

(Ej. PTB MEC 1)-> Hay 2 (PTB MEC 1) el 10/1/2013. y estos comprenden hora de ingreso - hora de entrega: 07:00 - 08:30 y 09:30 - 11:00.

Quiero que estos datos los busque en el ComboBox y los que esten en estos rangos les cambie el color de la fuente a Rojo. En el caso del ComboBox1 (Hora de ingreso) cambie 07:00/07:30/08:00/09:30/10:00/10:30 a Rojo. y el ComboBox2 (Hora de entrega) cambie 07:30/08:00/08:30/10:00/10:30/11:00.

Agradezco su colaboracion, espero me haya hecho entender.

Título: Re: Cambiar fuente a un item de ComboBox
Publicado por: Danyfirex en 3 Octubre 2013, 20:54 pm
Con este código de ejemplo lo puedes hacer.

Debes iniciar primero el sub main()


formulario
Código
  1. Option Explicit
  2.  
  3. Private Sub Form_Load()
  4. Dim iIndex As Integer
  5.  
  6. For iIndex = 0 To 15
  7. Combo1.AddItem "Color " & iIndex
  8. Combo1.itemData(Combo1.NewIndex) = QBColor(iIndex)
  9. Next
  10. Combo1.ListIndex = 0
  11.  
  12. 'Subclass the "Form", to Capture the Combobox Notification Messages
  13. SubClassForm hWnd
  14. End Sub
  15.  
  16. Private Sub Form_Unload(Cancel As Integer)
  17. 'Release the SubClassing, Very Import to Prevent Crashing!
  18. RemoveSubClassing hWnd
  19. End Sub
  20.  
  21.  

Modulo
Código
  1. Option Explicit
  2.  
  3. Private Type RECT
  4. Left As Long
  5. Top As Long
  6. Right As Long
  7. Bottom As Long
  8. End Type
  9.  
  10. Private Type DRAWITEMSTRUCT
  11. CtlType As Long
  12. CtlID As Long
  13. itemID As Long
  14. itemAction As Long
  15. itemState As Long
  16. hwndItem As Long
  17. hdc As Long
  18. rcItem As RECT
  19. itemData As Long
  20. End Type
  21.  
  22. Private Type CWPSTRUCT
  23. lParam As Long
  24. wParam As Long
  25. message As Long
  26. hWnd As Long
  27. End Type
  28.  
  29. Private Type CREATESTRUCT
  30. lpCreateParams As Long
  31. hInstance As Long
  32. hMenu As Long
  33. hWndParent As Long
  34. cy As Long
  35. cx As Long
  36. y As Long
  37. x As Long
  38. style As Long
  39. 'These next 2 are Normaly string, but need to be a fixed length
  40. 'so we know how long they are when using CopyMemory,
  41. 'We're only interested in the Style property anyway.
  42. lpszName As Long
  43. lpszClass As Long
  44. ExStyle As Long
  45. End Type
  46.  
  47. Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
  48.  
  49. Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  50. Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  51. Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
  52. Private Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
  53. Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
  54. Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
  55. Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
  56. Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
  57. Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
  58. Private Declare Function GetBkColor Lib "gdi32" (ByVal hdc As Long) As Long
  59. Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
  60. Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
  61. Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
  62. Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
  63. Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
  64.  
  65. Private Const WH_CALLWNDPROC = 4
  66.  
  67. Private Const CBS_OWNERDRAWVARIABLE = &H20&
  68. Private Const CB_GETLBTEXT = &H148
  69. Private Const CB_SETITEMHEIGHT = &H153
  70.  
  71. Private Const COLOR_HIGHLIGHT = 13
  72. Private Const COLOR_HIGHLIGHTTEXT = 14
  73. Private Const COLOR_WINDOW = 5
  74. Private Const COLOR_WINDOWTEXT = 8
  75.  
  76. Private Const GWL_WNDPROC = (-4)
  77. Private Const GWL_STYLE = (-16)
  78.  
  79. Private Const ODS_SELECTED = &H1
  80.  
  81. Private Const ODT_COMBOBOX = 3
  82.  
  83. Private Const WM_CREATE = &H1
  84. Private Const WM_DRAWITEM = &H2B
  85.  
  86. Private lPrevWndProc As Long
  87. Private lHook As Long
  88. Private lSubCombo As Long
  89.  
  90. Sub Main()
  91. 'The Combobox is a little more tricky to manipulate than a Listbox
  92. 'So we need to do a little extra work to make it an "Owner Drawn" Control.
  93. lHook = SetWindowsHookEx(WH_CALLWNDPROC, AddressOf HookApp, App.hInstance, App.ThreadID)
  94. Form1.Show
  95. 'Once the Control. etc are Drawn, we can release the Hook
  96. Call UnhookWindowsHookEx(lHook)
  97. End Sub
  98.  
  99. Public Sub SubClassForm(ByVal hWnd As Long)
  100. lPrevWndProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf SubClassedForm)
  101. End Sub
  102.  
  103. Public Sub RemoveSubClassing(ByVal hWnd As Long)
  104. Call SetWindowLong(hWnd, GWL_WNDPROC, lPrevWndProc)
  105. End Sub
  106.  
  107. Public Function SubClassedForm(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  108. Dim tItem As DRAWITEMSTRUCT
  109. Dim sItem As String
  110. Dim lBackBrush As Long
  111.  
  112. If Msg = WM_DRAWITEM Then
  113.  
  114. 'This function only passes the Address of the DrawItem Structure, so we need to
  115. 'use the CopyMemory API to get a Copy into the Variable we setup:
  116. Call CopyMemory(tItem, ByVal lParam, Len(tItem))
  117.  
  118. 'If it's our Combobox..
  119. If tItem.CtlType = ODT_COMBOBOX Then
  120.  
  121. 'get the Item Text
  122. sItem = Space(255)
  123. Call SendMessage(tItem.hwndItem, CB_GETLBTEXT, tItem.itemID, ByVal sItem)
  124. sItem = Left(sItem, InStr(sItem, Chr(0)) - 1)
  125.  
  126. 'Select the Highlight Colors if this Item is currently selected
  127. If (tItem.itemState And ODS_SELECTED) Then
  128. lBackBrush = CreateSolidBrush(GetSysColor(COLOR_HIGHLIGHT))
  129. Call SetBkColor(tItem.hdc, GetSysColor(COLOR_HIGHLIGHT))
  130. Call SetTextColor(tItem.hdc, GetSysColor(COLOR_HIGHLIGHTTEXT))
  131. Else
  132. 'Otherwise, use the default Colors
  133. lBackBrush = CreateSolidBrush(GetSysColor(COLOR_WINDOW))
  134. Call SetBkColor(tItem.hdc, GetSysColor(COLOR_WINDOW))
  135. Call SetTextColor(tItem.hdc, tItem.itemData)
  136. End If
  137.  
  138. FillRect tItem.hdc, tItem.rcItem, lBackBrush
  139.  
  140. 'Display the Item
  141. TextOut tItem.hdc, tItem.rcItem.Left, tItem.rcItem.Top, ByVal sItem, Len(sItem)
  142.  
  143. 'Don't Return a Value as we've dealt with this Message ourselves
  144. SubClassedForm = 0
  145. Exit Function
  146. End If
  147. End If
  148.  
  149. 'Not our Combobox, so just process the Message as Normal
  150. SubClassedForm = CallWindowProc(lPrevWndProc, hWnd, Msg, wParam, lParam)
  151. End Function
  152.  
  153. Private Function HookApp(ByVal lHookID As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  154.  
  155. 'This Function will get called when Initializing the Form
  156. 'We want to Interupt it when it tries to create our Combobox..
  157. Dim tCWP As CWPSTRUCT
  158. Dim sClass As String
  159.  
  160. Call CopyMemory(tCWP, ByVal lParam, Len(tCWP))
  161.  
  162. If tCWP.message = WM_CREATE Then
  163. 'get the Control Classname
  164. sClass = Space(128)
  165. Call GetClassName(tCWP.hWnd, ByVal sClass, 128)
  166. sClass = Left(sClass, InStr(sClass, Chr(0)) - 1)
  167. 'If it's our Combobox, Sub-class it to Modify the Create Message..
  168. If sClass = "ComboLBox" Then
  169. lSubCombo = SetWindowLong(tCWP.hWnd, GWL_WNDPROC, AddressOf SubComboCreate)
  170. End If
  171. End If
  172. 'Continue the Hook Processing
  173. HookApp = CallNextHookEx(lHook, lHookID, wParam, ByVal lParam)
  174.  
  175. End Function
  176.  
  177. Private Function SubComboCreate(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  178. 'This Function will be called when the Combobox is about to be created
  179. Dim tCreate As CREATESTRUCT
  180.  
  181. If Msg = WM_CREATE Then
  182. 'Grab the Data that's going to be used to Create the Combobox
  183. Call CopyMemory(tCreate, ByVal lParam, Len(tCreate))
  184. 'Alter it, to make the Combobox an "Owner Drawn" Control
  185. tCreate.style = tCreate.style Or CBS_OWNERDRAWVARIABLE
  186. 'Copy the modified data back
  187. Call CopyMemory(ByVal lParam, tCreate, Len(tCreate))
  188. 'Alter the Style to OwnerDrawn
  189. Call SetWindowLong(hWnd, GWL_STYLE, tCreate.style)
  190. 'Release this Subclassing Function
  191. Call SetWindowLong(hWnd, GWL_WNDPROC, lSubCombo)
  192. End If
  193. 'let Windows Process the Modified Data
  194. SubComboCreate = CallWindowProc(lSubCombo, hWnd, Msg, wParam, lParam)
  195.  
  196. End Function
  197.  

saludos


Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines