elhacker.net cabecera Bienvenido(a), Visitante. Por favor Ingresar o Registrarse
¿Perdiste tu email de activación?.

 

 


Tema destacado: Guía actualizada para evitar que un ransomware ataque tu empresa


+  Foro de elhacker.net
|-+  Programación
| |-+  Programación General
| | |-+  .NET (C#, VB.NET, ASP)
| | | |-+  Programación Visual Basic (Moderadores: LeandroA, seba123neo)
| | | | |-+  [SRC] cListBoxMultiAlign [by Mr. Frog ©]
0 Usuarios y 1 Visitante están viendo este tema.
Páginas: [1] 2 Ir Abajo Respuesta Imprimir
Autor Tema: [SRC] cListBoxMultiAlign [by Mr. Frog ©]  (Leído 5,560 veces)
Psyke1
Wiki

Desconectado Desconectado

Mensajes: 1.089



Ver Perfil WWW
[SRC] cListBoxMultiAlign [by Mr. Frog ©]
« en: 15 Diciembre 2010, 00:38 am »

Os dejo mi ultima clase que sirve para justificar texto en un ListBox, la novedad es que puedes actuar sobre especificamente con cada Item, dejo el código:

Código
  1. Option Explicit
  2. '==================================================================================================
  3. ' º Class     : MultiAlignListBox.cls
  4. ' º Version   : 1.1
  5. ' º Author    : Mr.Frog ©
  6. ' º Country   : Spain
  7. ' º Mail      : vbpsyke1@mixmail.com
  8. ' º Date      : 14/12/2010
  9. ' º Twitter   : http://twitter.com/#!/PsYkE1
  10. ' º Tested on : WinXp & Win7
  11. ' º Greets    : LaVolpe & Raul338 & BlackZer0x & Karmany
  12. ' º Reference : http://www.elguille.info/colabora/vb2006/karmany_centrartextolistbox.htm
  13. ' º Recommended Websites :
  14. '       http://visual-coders.com.ar
  15. '       http://InfrAngeluX.Sytes.Net
  16. '==================================================================================================
  17.  
  18. Private Declare Function GetDialogBaseUnits Lib "user32" () As Long
  19. Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
  20. Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDC As Long) As Long
  21. Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
  22. Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
  23. 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
  24. Private Declare Function GetTextExtentPoint32 Lib "gdi32" Alias "GetTextExtentPoint32A" (ByVal hDC As Long, ByVal lpString As String, ByVal cbString As Long, lpSize As SIZE) As Long
  25.  
  26. Private Type RECT
  27.    Left    As Long
  28.    Top     As Long
  29.    Right   As Long
  30.    Bottom  As Long
  31. End Type
  32.  
  33. Private Type SIZE
  34.    cX      As Long
  35.    cY      As Long
  36. End Type
  37.  
  38. Private Const LB_SETTABSTOPS                        As Long = &H192&
  39. Private Const WM_GETFONT                            As Long = &H31&
  40.  
  41. Private Const CHARS_LIST                            As String = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890"
  42. Private Const CHARS_LEN                             As Long = &H3E&
  43.  
  44. Private myListBox                                   As ListBox
  45. Private lListhWnd                                   As Long
  46. Private lWidth                                      As Long
  47.  
  48. Public Sub SetListBox(myList As ListBox)
  49.    If Not (myList Is Nothing) Then
  50.        Set myListBox = myList
  51.        lListhWnd = myListBox.hwnd
  52.        SetRightTab
  53.    End If
  54. End Sub
  55.  
  56. Public Sub AddAlignItem(ByVal Item As String, ByVal Align As AlignmentConstants, Optional ByVal Index As Long = (-1))
  57. Dim lCenterAlign                                    As Long
  58.  
  59.    With myListBox
  60.        lCenterAlign = Int(.Width - PixelsPerUnit(Item))
  61.        If lCenterAlign < 0 Then Align = vbLeftJustify
  62.  
  63.        If Index = (-1) Then Index = .ListCount
  64.  
  65.        Select Case Align
  66.            Case vbRightJustify
  67.                .AddItem vbTab & Item, Index
  68.                If Not (lWidth = GetListSize) Then SetRightTab
  69.            Case vbCenter
  70.                .AddItem Space$(Abs(Int(lCenterAlign / PixelsPerUnit(Space$(1)) / 2) - 1.5)) & Item, Index
  71.            Case Else
  72.                .AddItem Item, Index
  73.        End Select
  74.    End With
  75. End Sub
  76.  
  77. Public Sub ChangeListBoxAlign(Optional ByVal Index As Long = (-1), Optional ByVal Align As AlignmentConstants = vbAlignLeft)
  78. Dim Q                                               As Long
  79.  
  80.    If Index > -1 Then
  81.        SetAlign Index, Align
  82.    Else
  83.        For Q = 0 To (myListBox.ListCount - 1)
  84.            SetAlign Q, Align
  85.        Next Q
  86.    End If
  87. End Sub
  88.  
  89. Public Function GetItem(ByVal Index As Long) As String
  90.    GetItem = LTrim$(myListBox.List(Index))
  91.  
  92.    If (GetItem Like (vbTab & "*")) Then
  93.        GetItem = Right$(GetItem, (Len(GetItem) - 1))
  94.    End If
  95. End Function
  96.  
  97. Private Sub SetAlign(ByVal Index As Long, ByVal Align As AlignmentConstants)
  98. Dim sItem                                           As String
  99.  
  100.    With myListBox
  101.        sItem = GetRealItem(Index)
  102.        If Not (.List(Index) = sItem) Then
  103.            .RemoveItem (Index)
  104.            AddAlignItem sItem, Align, Index
  105.        End If
  106.    End With
  107. End Sub
  108.  
  109. Private Sub SetRightTab()
  110. Dim lRightAlignTab                                  As Long
  111.  
  112.    lWidth = GetListSize
  113.    lRightAlignTab = -(lWidth / PixelsPerUnit)
  114.  
  115.    SendMessage lListhWnd, LB_SETTABSTOPS, &H0&, ByVal &H0&
  116.    SendMessage lListhWnd, LB_SETTABSTOPS, &H1&, lRightAlignTab
  117.  
  118.    myListBox.Refresh
  119. End Sub
  120.  
  121. Private Function GetListSize() As Long
  122. Dim RCT                                             As RECT
  123.  
  124.    GetClientRect lListhWnd, RCT
  125.    With RCT
  126.        GetListSize = (.Right - .Left)
  127.    End With
  128. End Function
  129.  
  130.  
  131. Private Function PixelsPerUnit(Optional ByVal sText As String) As Single
  132. Dim hDC                                             As Long
  133. Dim hFont                                           As Long
  134. Dim hFontOld                                        As Long
  135. Dim SZ                                              As SIZE
  136.  
  137.    hDC = GetDC(lListhWnd)
  138.    If CBool(hDC) = True Then
  139.        hFont = SendMessage(lListhWnd, WM_GETFONT, &H0&, ByVal &H0&)
  140.        hFontOld = SelectObject(hDC, hFont)
  141.  
  142.        If sText = vbNullString Then
  143.            If GetTextExtentPoint32(hDC, CHARS_LIST, CHARS_LEN, SZ) Then
  144.                PixelsPerUnit = CSng((2 * CLng(SZ.cX / CHARS_LEN)) / (GetDialogBaseUnits And &HFFFF&))
  145.            End If
  146.        Else
  147.            If GetTextExtentPoint32(hDC, sText, Len(sText), SZ) Then
  148.                PixelsPerUnit = (SZ.cX * Screen.TwipsPerPixelX)
  149.            End If
  150.        End If
  151.  
  152.        SelectObject hDC, hFontOld
  153.        ReleaseDC lListhWnd, hDC
  154.    End If
  155. End Function
  156.  
  157. Private Sub Class_Initialize()
  158.    Debug.Print "--> cListBoxMultiAlign.cls By Mr.Frog © <--"
  159. End Sub

Una imagen vale mas que 1000 palabras:

DoEvents! :P


« Última modificación: 17 Diciembre 2010, 14:52 pm por Mr. Frog © » En línea

agus0


Desconectado Desconectado

Mensajes: 360



Ver Perfil
Re: [SRC] cListBoxMultiAlign [by Mr. Frog ©]
« Respuesta #1 en: 15 Diciembre 2010, 01:12 am »

Muy Bien  ;-) ;-) ;-)


En línea

BlackZeroX
Wiki

Desconectado Desconectado

Mensajes: 3.158


I'Love...!¡.


Ver Perfil WWW
Re: [SRC] cListBoxMultiAlign [by Mr. Frog ©]
« Respuesta #2 en: 15 Diciembre 2010, 01:27 am »

.
Bonito

P.D.: casi no le ponias la referencia ¬¬"

Dulces Lunas!¡.
En línea

The Dark Shadow is my passion.
Psyke1
Wiki

Desconectado Desconectado

Mensajes: 1.089



Ver Perfil WWW
Re: [SRC] cListBoxMultiAlign [by Mr. Frog ©]
« Respuesta #3 en: 15 Diciembre 2010, 01:35 am »

.
Bonito

P.D.: casi no le ponias la referencia ¬¬"

Dulces Lunas!¡.
Gracias! ;)
:xD
Ya la puse, y ya avise a karmany por MP para que le heche un vistazo!  ;D

DoEvents! :P
En línea

Psyke1
Wiki

Desconectado Desconectado

Mensajes: 1.089



Ver Perfil WWW
Re: [SRC] cListBoxMultiAlign [by Mr. Frog ©]
« Respuesta #4 en: 15 Diciembre 2010, 01:42 am »

Tambien se me ocurrio esta forma de centrar el texto sin Apis y sin agregar controles adicionales, aunque es un poco fea (pero funciona :silbar:) :

En un módulo:

Código
  1. Option Explicit
  2. '=========================================================
  3. ' º Function : AlignCenterLBItem
  4. ' º Author   : Mr.Frog ©
  5. ' º Mail     : vbpsyke1@mixmail.com
  6. ' º Greets   : LeandroA
  7. ' º Recommended Websites :
  8. '       http://visual-coders.com.ar
  9. '       http://InfrAngeluX.Sytes.Net
  10. '       http://twitter.com/#!/PsYkE1
  11. '=========================================================
  12.  
  13. Public Function AlignCenterLBItem(myListbox As ListBox, ByVal sItem As String) As String
  14. Dim lItemLen                                           As Long
  15.    If Not (myListbox Is Nothing) Then
  16.        lItemLen = myListbox.Parent.TextWidth(sItem)
  17.        If lItemLen < myListbox.Width Then
  18.            AlignCenterLBItem = Space$(Abs(Int((Int(myListbox.Width - lItemLen) / 2) / myListbox.Parent.TextWidth(Space$(1)) - 1.5))) & sItem
  19.        End If
  20.    End If
  21. End Function

Ejemplo:
Código
  1. Private Sub Form_Load()
  2.    List1.AddItem AlignCenterLBItem(List1, "Amo elhacker.net")
  3. End Sub
:xD

Es lo más corto que he visto...  ::)

DoEvents! :P
« Última modificación: 16 Diciembre 2010, 10:18 am por Mr. Frog © » En línea

79137913


Desconectado Desconectado

Mensajes: 1.169


4 Esquinas


Ver Perfil WWW
Re: [SRC] cListBoxMultiAlign [by Mr. Frog ©]
« Respuesta #5 en: 15 Diciembre 2010, 11:53 am »

HOLA!!!

Muy bueno!!!
Lo que quisiera saber es si se puede hacer un Item Multiline.

GRACIAS POR LEER!!!
En línea

"Como no se puede igualar a Dios, ya he decidido que hacer, ¡SUPERARLO!"
"La peor de las ignorancias es no saber corregirlas"

 79137913                          *Shadow Scouts Team*
ssccaann43 ©


Desconectado Desconectado

Mensajes: 792


¬¬


Ver Perfil
Re: [SRC] cListBoxMultiAlign [by Mr. Frog ©]
« Respuesta #6 en: 15 Diciembre 2010, 14:42 pm »

Si se puede, BlackZerox y Ranita saben...!  :silbar:
En línea

- Miguel Núñez
Todos tenemos derechos a ser estupidos, pero algunos abusan de ese privilegio...
"I like ^TiFa^"
Psyke1
Wiki

Desconectado Desconectado

Mensajes: 1.089



Ver Perfil WWW
Re: [SRC] cListBoxMultiAlign [by Mr. Frog ©]
« Respuesta #7 en: 15 Diciembre 2010, 18:31 pm »

Si se puede, BlackZerox y Ranita saben...!  :silbar:
:xD
Pues creo que esta vez te equivocas... :rolleyes:

@79137913
Eso no será sencillo, para ello puedes buscar algun UC (despues busco y posteo si encuentro algo), o quizas se pueda hacer algo con otro control; un LV o un MSFLGRND (no lo se :-\).
Tengo aun que mejorar esta clase que tiene algun bug por ahi... Despues actualizo.

DoEvents! :P
En línea

ssccaann43 ©


Desconectado Desconectado

Mensajes: 792


¬¬


Ver Perfil
Re: [SRC] cListBoxMultiAlign [by Mr. Frog ©]
« Respuesta #8 en: 15 Diciembre 2010, 20:27 pm »

Se puede hacer con un UC...! Pero con el List normal, sinceramente lo dificulto..! BlackZerox anda ya creando controles List y ListView con excelentes bondades y muy bonitos esteticamente,  :¬¬ "aunque aveces la gran mayoria de sus colores inframundos son negros" jaja  :xD

Pero igual se que el sabe sobre ese tema..!

PD: Ranita no te hagas de rogar, vos sabes como es...!  :silbar:
En línea

- Miguel Núñez
Todos tenemos derechos a ser estupidos, pero algunos abusan de ese privilegio...
"I like ^TiFa^"
karmany
Colaborador
***
Desconectado Desconectado

Mensajes: 1.615


Sueñas que sueñas


Ver Perfil WWW
Re: [SRC] cListBoxMultiAlign [by Mr. Frog ©]
« Respuesta #9 en: 16 Diciembre 2010, 17:21 pm »

Excelente código Mr. Frog.
Con tu mp me basta, por mi no hace falta que me incluyas en el membrete de tu código pues lo has hecho tú todo...

Lo he probado y ahora no tengo tiempo para analizarlo pero no alinea bien a la derecha (VB6 - Windows XP SP3):
En línea

Páginas: [1] 2 Ir Arriba Respuesta Imprimir 

Ir a:  

Mensajes similares
Asunto Iniciado por Respuestas Vistas Último mensaje
[SRC] Check_Similar_Words [by Mr. Frog ©] « 1 2 »
Programación Visual Basic
Psyke1 15 6,781 Último mensaje 9 Enero 2011, 23:36 pm
por agus0
[SRC] FrogCheat v1.1 [by Mr. Frog ©] « 1 2 3 »
Programación Visual Basic
Psyke1 28 14,313 Último mensaje 6 Enero 2011, 18:13 pm
por ssccaann43 ©
[SRC] [Tip] AlignListBox [by Mr. Frog ©]
Programación Visual Basic
Psyke1 3 2,298 Último mensaje 13 Diciembre 2010, 03:36 am
por agus0
[SRC] cFrogContest.cls [by Mr. Frog ©] « 1 2 »
Programación Visual Basic
Psyke1 12 7,209 Último mensaje 12 Febrero 2011, 22:29 pm
por Psyke1
[SRC] IIfEx [by Mr. Frog ©]
Programación Visual Basic
Psyke1 2 1,931 Último mensaje 11 Febrero 2011, 15:15 pm
por Psyke1
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines