Mostrar Mensajes

Visual Basic 6 / Ayuda chkTransparente ctl

« en: Febrero 08, 2011, 02:33:05 pm »
Hola por cosas de la vida, me dio por modificar un control de usuario para hacer que el checkbox fuese transparente y en cierta forma lo logre el problema es que solo queda el checkbox y no muestra el caption del control.

Asi que si alguien puede hecharle un vistazo al codigo para decirme que me falta o que hago mal y lograr que funcione.
Basicamente cambie un checkbox normal por un Label y le añadi al codigo la funcion BackStyle

aca le pueden hechar un vistazo y ver de lo que hablo: http://www.mediafire.com/?ac43chaj0rjhubm

Saludos!
Código: [Seleccionar]
Private Declare Function GetCursorPos Lib "user32.dll" (lpPoint As POINT_TYPE) As Long
Private Declare Function WindowFromPoint Lib "user32.dll" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function IsChild Lib "user32.dll" (ByVal hWndParent As Long, ByVal hWnd As Long) As Long

Private Type POINT_TYPE
  X As Long
  Y As Long
End Type

Enum CheckTypes
    Unchecked = 0
    Checked = 1
    Greyed = 2
End Enum
Enum BackStyles
Transparent = 0
Opaque = 1
End Enum
Dim Respond As Boolean
Dim OValue As CheckTypes
Dim isEnabled As Boolean
Dim backs As BackStyles
Event Click()
Event DblClick()
Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'Default Property Values:
Const m_def_DisabledColor = &HC0C0C0
'Const backs = 0
'Property Variables:
Dim m_ForeColor As OLE_COLOR
Dim m_DisabledColor As OLE_COLOR

Private Sub check1_Click()

End Sub

Private Sub picture1_DblClick()
If Respond = False Then Exit Sub
RaiseEvent DblClick
End Sub

Private Sub picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error Resume Next
If Respond = False Then Exit Sub

RaiseEvent MouseDown(Button, Shift, X, Y)
If Button = 2 Then Exit Sub

Timer1.Enabled = False
Select Case OValue
Case Checked
    Picture1.Picture = PushedChecked.Picture: OValue = 0
Case Unchecked
    Picture1.Picture = PushedNoValue.Picture: OValue = 1
Case Greyed
    Picture1.Picture = PushedGreyed.Picture: OValue = 0
End Select
End Sub

Private Sub picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error Resume Next
If Respond = False Or Button = 2 Then Exit Sub
RaiseEvent Click
Timer1.Enabled = True
End Sub

Private Sub Label1_DblClick()
RaiseEvent DblClick
End Sub
Private Sub Label1_Click()
RaiseEvent Click
End Sub
Private Sub label1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
picture1_MouseDown Button, Shift, X, Y
End Sub

Private Sub label1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
picture1_MouseUp Button, Shift, X, Y
End Sub

Private Sub Timer1_Timer()
On Error Resume Next
Dim CursorPos As POINT_TYPE

GetCursorPos CursorPos

If Enabled = False Then Exit Sub

po = WindowFromPoint(CursorPos.X, CursorPos.Y)
If WindowFromPoint(CursorPos.X, CursorPos.Y) = Picture1.hWnd Then
    Select Case OValue
    Case Checked
       ' Picture1.Picture = MouseoverChecked.Picture
    Case Unchecked
        'Picture1.Picture = MouseoverNoValue.Picture
    Case Greyed
        'Picture1.Picture = MouseoverGreyed.Picture
    End Select
        Else
            Select Case OValue
            Case Checked
                Picture1.Picture = IdleChecked.Picture
            Case Unchecked
                Picture1.Picture = IdleNoValue.Picture
            Case Greyed
                Picture1.Picture = IdleGreyed.Picture
            End Select
End If


End Sub

Property Let Value(Yes As CheckTypes)
On Error Resume Next
OValue = Yes

Select Case Yes
Case Checked
    If isEnabled = True Then Picture1.Picture = IdleChecked.Picture Else Picture1.Picture = CheckedDisabled.Picture
Case Unchecked
    If isEnabled = True Then Picture1.Picture = IdleNoValue.Picture Else Picture1.Picture = DisabledNoValue.Picture
Case Greyed
    If isEnabled = True Then Picture1.Picture = IdleGreyed.Picture Else Picture1.Picture = DisabledGrey.Picture
End Select
End Property

Property Get Value() As CheckTypes
On Error Resume Next
Select Case OValue
Case Checked
    If isEnabled = True Then Picture1.Picture = IdleChecked.Picture Else Picture1.Picture = CheckedDisabled.Picture
Case Unchecked
    If isEnabled = True Then Picture1.Picture = IdleNoValue.Picture Else Picture1.Picture = DisabledNoValue.Picture
Case Greyed
    If isEnabled = True Then Picture1.Picture = IdleGreyed.Picture Else Picture1.Picture = DisabledGrey.Picture
End Select
'************************
Value = OValue
End Property

Private Sub UserControl_InitProperties()
BackStyle = Transparent
Value = False
Caption = Name

Enabled = True

Set Font = Parent.Font
m_ForeColor = m_def_ForeColor
m_DisabledColor = m_def_DisabledColor
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
Enabled = PropBag.ReadProperty("Enabled", True)
Value = PropBag.ReadProperty("Value", Unchecked)
Caption = PropBag.ReadProperty("Caption", Name)
BackStyle = PropBag.ReadProperty("BackStyle", BackStyle)

Set Font = PropBag.ReadProperty("Font", Parent.Font)

With Label1
    .BackStyle = PropBag.ReadProperty("BackStyle", BackStyle)
    .ForeColor = PropBag.ReadProperty("ForeColor", &H800000)
    .Caption = PropBag.ReadProperty("Caption", UserControl.Name)
    .BackColor = PropBag.ReadProperty("BackColor", &HFFFFFF)
    
End With
m_ForeColor = PropBag.ReadProperty("ForeColor", m_def_ForeColor)
m_DisabledColor = PropBag.ReadProperty("DisabledColor", m_def_DisabledColor)
End Sub

Private Sub UserControl_Resize()
On Error Resume Next
Picture1.Top = (UserControl.Height / 2) - Picture1.Height / 2
    With Label1
        UserControl.BackColor = .BackColor
        If Enabled = True Then .ForeColor = ForeColor Else .ForeColor = DisabledColor
        .Width = UserControl.Width - .Left
        .Height = UserControl.Height
        .Top = ((UserControl.Height / 2) - .Height / 2)
    End With
End Sub

Private Sub UserControl_Show()
Timer1.Enabled = UserControl.Ambient.UserMode
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)


PropBag.WriteProperty "Value", OValue, Unchecked
PropBag.WriteProperty "Caption", Label1.Caption, Name
PropBag.WriteProperty "Enabled", isEnabled, True
PropBag.WriteProperty "Font", Label1.Font, Parent.Font
PropBag.WriteProperty "BackStyle", Label1.BackStyle, BackStyle
    Call PropBag.WriteProperty("ForeColor", Label1.ForeColor, &H800000)
    Call PropBag.WriteProperty("Caption", Label1.Caption, "label1")
    Call PropBag.WriteProperty("BackColor", Label1.BackColor, &HFFFFFF)
    Call PropBag.WriteProperty("ForeColor", m_ForeColor, m_def_ForeColor)
    Call PropBag.WriteProperty("DisabledColor", m_DisabledColor, m_def_DisabledColor)
    Call PropBag.WriteProperty("BackStyle", Label1.BackStyle, BackStyle)
End Sub

Public Property Set Font(newFont As IFontDisp)
Set Label1.Font = newFont
End Property

Public Property Get Font() As IFontDisp
Set Font = Label1.Font
End Property

Property Let Enabled(Yes As Boolean)
On Error Resume Next
isEnabled = Yes

If Yes = True Then
    Select Case OValue
    Case Checked
        Picture1.Picture = IdleChecked.Picture
    Case Unchecked
        Picture1.Picture = IdleNoValue.Picture
    Case Greyed
        Picture1.Picture = IdleGreyed.Picture
    End Select
    Respond = True
    Label1.ForeColor = ForeColor
    Timer1.Enabled = UserControl.Ambient.UserMode
        Else
            Select Case OValue
            Case Checked
                Picture1.Picture = DisabledChecked.Picture
            Case Unchecked
                Picture1.Picture = DisabledNoValue.Picture
            Case Greyed
                Picture1.Picture = DisabledGrey.Picture
            End Select
            Timer1.Enabled = False
            Respond = False
            Label1.ForeColor = DisabledColor
End If
End Property

Property Get Enabled() As Boolean
Enabled = isEnabled
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=label1,label1,-1,Caption
Public Property Get BackStyle() As BackStyles
    BackStyle = Label1.BackStyle
End Property

Public Property Let BackStyle(ByVal new_Style As BackStyles)
If new_Style = Opaque Then
UserControl.BackStyle = new_Style
'Label1.ForeColor = m_ForeColor
Label1.BackStyle = new_Style: End If
If new_Style = Transparent Then
 UserControl.BackStyle = new_Style
' Label1.ForeColor = m_ForeColor
 Label1.BackStyle = new_Style: End If
    PropertyChanged "BackStyle"
End Property

Public Property Get Caption() As String
    Caption = Label1.Caption
End Property
Public Property Let Caption(ByVal new_caption As String)
    Label1.Caption() = new_caption
    PropertyChanged "Caption"
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=label1,label1,-1,BackColor
Public Property Get BackColor() As OLE_COLOR
    BackColor = Label1.BackColor
End Property

Public Property Let BackColor(ByVal new_BackColor As OLE_COLOR)
    Label1.BackColor() = new_BackColor
    UserControl.BackColor = new_BackColor
    PropertyChanged "BackColor"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=10,0,0,
Public Property Get ForeColor() As OLE_COLOR
    ForeColor = m_ForeColor
End Property

Public Property Let ForeColor(ByVal New_ForeColor As OLE_COLOR)
    m_ForeColor = New_ForeColor
    PropertyChanged "ForeColor"
    Label1.ForeColor = m_ForeColor
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=10,0,0,&H00C0C0C0&
Public Property Get DisabledColor() As OLE_COLOR
    DisabledColor = m_DisabledColor
End Property

Public Property Let DisabledColor(ByVal New_DisabledColor As OLE_COLOR)
    m_DisabledColor = New_DisabledColor
    PropertyChanged "DisabledColor"
End Property
Visual Basic Foro

Noticias:

Mostrar Mensajes

Mensajes - truxk

Visual Basic 6 / Re:[Proyecto] Administración Remota

Visual Basic 6 / Ayuda chkTransparente ctl
