Автор вопроса: DaaGER | Web-сайт:smartic.ru | ICQ: 329195567
Здрасьте! В создание контролов я АБСОЛЮТНЫЙ ноль, но назначение их я понимаю.
У меня такая проблема: нужно создать контрол у которого будет лишь одно свойство: InfinityColor.
Человек переносит на форму этот контрол в этот контрол вводит цвет который нужно сделать прозрачным и этот цвет исчезает. Вот и всё что мне нужно!
На всякий случай вот код чтобы делать цвет прозрачным
Const LWA_COLORKEY = &H1
Const LWA_ALPHA = &H2
Const GWL_EXSTYLE = (-20)
Const WS_EX_LAYERED = &H80000
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, yVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Private Sub Command1_Click()
Dim Ret As Long
Ret = GetWindowLong(Me.hWnd, GWL_EXSTYLE)
Ret = Ret Or WS_EX_LAYERED
SetWindowLong Me.hWnd, GWL_EXSTYLE, Ret
SetLayeredWindowAttributes Me.hWnd, Val(ПРОЗРАЧНЫЙ ЦВЕТ), 0, LWA_COLORKEY
End Sub
P.S.
Если не сложно можете подробно написать как вы делали этот самый контрол.
Заранее спасибо всем, кто уделит время решению моей проблемы!!!
Привет.
Болванку для контрола я делаю при помощи ActivX Control Interface Wizard, а потом редактирую код на свой лад.
код контрола:
___________________
Const m_def_InfinityColor = 0
Dim m_InfinityColor As Long
Const LWA_COLORKEY = &H1
Const LWA_InfinityColor = &H2
Const GWL_EXSTYLE = (-20)
Const WS_EX_LAYERED = &H80000
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bInfinityColor As Byte, ByVal dwFlags As Long) As Long
Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Public Property Get InfinityColor() As Long
InfinityColor = m_InfinityColor
End Property
Public Property Let InfinityColor(ByVal New_InfinityColor As Long)
m_InfinityColor = New_InfinityColor
 im p As Long
p = GetParent(UserControl.hwnd)
 im Ret As Long
Ret = GetWindowLong(p, GWL_EXSTYLE)
Ret = Ret Or WS_EX_LAYERED
SetWindowLong p, GWL_EXSTYLE, Ret
SetLayeredWindowAttributes p, InfinityColor, 0, LWA_COLORKEY
PropertyChanged "InfinityColor"
End Property
Public Sub Refresh()
Dim p As Long
p = GetParent(UserControl.hwnd)
Dim Ret As Long
Ret = GetWindowLong(p, GWL_EXSTYLE)
Ret = Ret Or WS_EX_LAYERED
SetWindowLong p, GWL_EXSTYLE, Ret
SetLayeredWindowAttributes p, InfinityColor, 0, LWA_COLORKEY
End Sub
Private Sub UserControl_InitProperties()
m_InfinityColor = m_def_InfinityColor
End Sub
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
m_InfinityColor = PropBag.ReadProperty("InfinityColor", m_def_InfinityColor)
End Sub
Private Sub UserControl_Resize()
If UserControl.Width <> 300 Then UserControl.Width = 300
If UserControl.Height <> 300 Then UserControl.Height = 300
End Sub
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
Call PropBag.WriteProperty("InfinityColor", m_InfinityColor, m_def_InfinityColor)
End Sub
___________________
применение на форме:
___________________
Private Sub Command1_Click()
AlphaControl.InfinityColor = 7115203
End Sub
___________________