Autor Tema: Algun control tipo Label con [x] para cerrar?  (Leído 3292 veces)

0 Usuarios y 1 Visitante están viendo este tema.

Waldo

  • Gigabyte
  • ****
  • Mensajes: 264
  • Reputación: +22/-0
    • Ver Perfil
Algun control tipo Label con [x] para cerrar?
« en: Julio 29, 2014, 11:34:29 am »
Hola amigos, por casualidad alguien tiene o vio algun usercontrol tipo un label con una [ X ] para cerrar, el tipico que se muestra cuando el usuario va agregando filtros, y desp desde la [X] remueve ese fltro.

Algo asi:


LeandroA

  • Administrador
  • Petabyte
  • *****
  • Mensajes: 1128
  • Reputación: +151/-8
    • Ver Perfil
Re:Algun control tipo Label con [x] para cerrar?
« Respuesta #1 en: Julio 29, 2014, 04:38:56 pm »
Hola Waldo, te paso gran parte del código, después vos le agregas lo que necesites,
solo tiene el evento  CrossClick, es el click de la cruz.
Código: (vb) [Seleccionar]
Option Explicit
Private Declare Function SetRect Lib "user32.dll" (ByRef lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function OffsetRect Lib "user32.dll" (ByRef lpRect As RECT, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function DrawText Lib "user32.dll" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, ByRef lpRect As RECT, ByVal wFormat As Long) As Long
Private Declare Function CreateRoundRectRgn Lib "gdi32.dll" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
Private Declare Function SetWindowRgn Lib "user32.dll" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Const DT_VCENTER As Long = &H4
Private Const DT_SINGLELINE As Long = &H20
Private Const DT_RIGHT As Long = &H2
Private Const DT_LEFT As Long = &H0
Private Const DT_WORD_ELLIPSIS As Long = &H40000


Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Public Event CrossClick()

Private m_Caption As String
Private m_ForeColor As OLE_COLOR
Private m_ShadowColor As OLE_COLOR

Public Property Get Caption() As String
    Caption = m_Caption
End Property

Public Property Let Caption(ByVal Value As String)
    m_Caption = Value
    Call PropertyChanged("Caption")
    UserControl_Resize
End Property
   
Public Property Get BackColor() As OLE_COLOR
    BackColor = UserControl.BackColor
End Property

Public Property Let BackColor(ByVal Value As OLE_COLOR)
    UserControl.BackColor = Value
    Call PropertyChanged("BackColor")
    UserControl_Resize
End Property

Public Property Get ForeColor() As OLE_COLOR
    ForeColor = m_ForeColor
End Property

Public Property Let ForeColor(ByVal Value As OLE_COLOR)
    m_ForeColor = Value
    Call PropertyChanged("ForeColor")
    UserControl_Resize
End Property

Public Property Get ShadowColor() As OLE_COLOR
    ShadowColor = m_ShadowColor
End Property

Public Property Let ShadowColor(ByVal Value As OLE_COLOR)
    m_ShadowColor = Value
    Call PropertyChanged("ShadowColor")
    UserControl_Resize
End Property

Public Property Get Font() As StdFont
    Set Font = UserControl.Font
End Property

Public Property Set Font(ByVal NewFont As StdFont)
    Set UserControl.Font = NewFont
    Call PropertyChanged("Font")
    UserControl_Resize
End Property


Private Sub UserControl_Initialize()
    UserControl.ScaleMode = vbPixels
    UserControl.AutoRedraw = True
End Sub

Private Sub UserControl_InitProperties()
    m_Caption = Ambient.DisplayName
    UserControl.BackColor = vbActiveBorder
    m_ForeColor = Ambient.ForeColor
    UserControl.Font = Ambient.Font
    m_ShadowColor = vb3DHighlight
End Sub


Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If X > UserControl.ScaleWidth - 20 And X < UserControl.ScaleWidth And Y > (UserControl.ScaleHeight / 2) - 4 And Y < (UserControl.ScaleHeight / 2) + 4 Then
        RaiseEvent CrossClick
    End If
End Sub

Private Sub UserControl_Resize()
    Dim hRgn As Long
    Dim tRECT As RECT
   
   
    'Redondear Puntas
    hRgn = CreateRoundRectRgn(0, 0, UserControl.ScaleWidth, UserControl.ScaleHeight, 7, 7)
    SetWindowRgn UserControl.hWnd, hRgn, True

   
    UserControl.Cls
    SetRect tRECT, 5, 5, UserControl.ScaleWidth - 4 - 16, UserControl.ScaleHeight - 4
   
    'Sombra del texto
    UserControl.ForeColor = m_ShadowColor
    DrawText UserControl.hdc, m_Caption, Len(m_Caption), tRECT, DT_LEFT Or DT_SINGLELINE Or DT_VCENTER Or DT_WORD_ELLIPSIS

    'Texto
    OffsetRect tRECT, -1, -1
    UserControl.ForeColor = m_ForeColor
    DrawText UserControl.hdc, m_Caption, Len(m_Caption), tRECT, DT_LEFT Or DT_SINGLELINE Or DT_VCENTER Or DT_WORD_ELLIPSIS
   
    'Sombra de la Cruz
    DrawCross UserControl.ScaleWidth - 17, (UserControl.ScaleHeight / 2) - 3, 8, 8, 2, m_ShadowColor
    'Cruz
    DrawCross UserControl.ScaleWidth - 18, (UserControl.ScaleHeight / 2) - 4, 8, 8, 2, m_ForeColor
   
   
    UserControl.Refresh
   
End Sub

Private Sub DrawCross(ByVal Left As Long, ByVal Top As Long, ByVal Width As Long, ByVal Heigth As Long, ByVal PenWidth As Long, ByVal ForeColor As OLE_COLOR)
    UserControl.DrawWidth = PenWidth
    UserControl.ForeColor = ForeColor
    UserControl.Line (Left, Top)-(Left + Width, Top + Heigth)
    UserControl.Line (Left, Top + Heigth)-(Left + Width, Top)
End Sub

Private Sub UserControl_Show()
    UserControl_Resize
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    With PropBag
        UserControl.BackColor = .ReadProperty("BackColor", vbActiveBorder)
        m_ForeColor = .ReadProperty("ForeColor", Ambient.ForeColor)
        m_ShadowColor = .ReadProperty("ShadowColor", vb3DHighlight)
        m_Caption = .ReadProperty("Caption", Ambient.DisplayName)
    End With
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    With PropBag
        Call .WriteProperty("BackColor", UserControl.BackColor)
        Call .WriteProperty("ForeColor", m_ForeColor)
        Call .WriteProperty("ShadowColor", m_ShadowColor)
        Call .WriteProperty("Caption", m_Caption)
    End With
End Sub


Waldo

  • Gigabyte
  • ****
  • Mensajes: 264
  • Reputación: +22/-0
    • Ver Perfil
Re:Algun control tipo Label con [x] para cerrar?
« Respuesta #2 en: Julio 29, 2014, 05:00:32 pm »
Muchas gracias Lean!

Ya lo tenias hecho, o era de algun control similar ?

LeandroA

  • Administrador
  • Petabyte
  • *****
  • Mensajes: 1128
  • Reputación: +151/-8
    • Ver Perfil
Re:Algun control tipo Label con [x] para cerrar?
« Respuesta #3 en: Julio 29, 2014, 05:13:15 pm »
Tengo que hacer uno, pero de otro estilo mas de tipo marquesina, pero me vienen bien muchas de las propiedades para ir adelantando.

Waldo

  • Gigabyte
  • ****
  • Mensajes: 264
  • Reputación: +22/-0
    • Ver Perfil
Re:Algun control tipo Label con [x] para cerrar?
« Respuesta #4 en: Julio 30, 2014, 11:29:49 am »
Lean funciona perfecto, lo unico que le tuve que agregar fue guardar el font.

Código: (VB) [Seleccionar]
Private Sub UserControl_InitProperties()
    m_Caption = Ambient.DisplayName
    UserControl.BackColor = vbActiveBorder
    m_ForeColor = Ambient.ForeColor
    Set UserControl.Font = Ambient.Font
    m_ShadowColor = vb3DHighlight
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    With PropBag
        Set UserControl.Font = .ReadProperty("Font", Ambient.Font)
        UserControl.BackColor = .ReadProperty("BackColor", vbActiveBorder)
        m_ForeColor = .ReadProperty("ForeColor", Ambient.ForeColor)
        m_ShadowColor = .ReadProperty("ShadowColor", vb3DHighlight)
        m_Caption = .ReadProperty("Caption", Ambient.DisplayName)
    End With
End Sub
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    With PropBag
        Call .WriteProperty("Font", UserControl.Font)
        Call .WriteProperty("BackColor", UserControl.BackColor)
        Call .WriteProperty("ForeColor", m_ForeColor)
        Call .WriteProperty("ShadowColor", m_ShadowColor)
        Call .WriteProperty("Caption", m_Caption)
    End With
End Sub