Страница: 1 |
Вопрос: КОНТРОЛЫ | Добавлено: 18.06.06 03:57 |
Автор вопроса: ![]() |
Здрасьте! В создание контролов я АБСОЛЮТНЫЙ ноль, но назначение их я понимаю.
У меня такая проблема: нужно создать контрол у которого будет лишь одно свойство: 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. Если не сложно можете подробно написать как вы делали этот самый контрол. Заранее спасибо всем, кто уделит время решению моей проблемы!!! |
Ответы | Всего ответов: 2 |
Номер ответа: 1 Автор ответа: ![]() ![]() ![]() ![]() ![]() ![]() ![]() ICQ: 262809473 Вопросов: 17 Ответов: 561 |
Web-сайт: Профиль | Цитата | #1 | Добавлено: 18.06.06 11:37 |
Привет.
Болванку для контрола я делаю при помощи 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 ![]() p = GetParent(UserControl.hwnd) ![]() 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 ___________________ Удачи! |
Номер ответа: 2 Автор ответа: ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() ICQ: 329195567 Вопросов: 52 Ответов: 67 |
Web-сайт: Профиль | Цитата | #2 | Добавлено: 21.06.06 08:48 |
СПАСИБО ТЕБЕ ДОБРАЯ ДУША |
Страница: 1 |
|