Visual Basic Foro
Programación => Visual Basic 6 => Mensaje iniciado por: Waldo 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:
(http://i59.tinypic.com/6pwbxe.jpg)
-
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.
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
-
Muchas gracias Lean!
Ya lo tenias hecho, o era de algun control similar ?
-
Tengo que hacer uno, pero de otro estilo mas de tipo marquesina, pero me vienen bien muchas de las propiedades para ir adelantando.
-
Lean funciona perfecto, lo unico que le tuve que agregar fue guardar el font.
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
(http://i62.tinypic.com/25iszmv.png)