Страница: 1 |
Вопрос: Нужен Label с тенью | Добавлено: 29.08.06 18:28 |
Автор вопроса: ![]() |
Писать влом что-то :) Дайте готовый...
искал в инете, несколько ocx'ов нашёл, но нах мне ocx'ы. Надо UserControl... |
Ответы | Всего ответов: 8 |
Номер ответа: 1 Автор ответа: ![]() ![]() ![]() ![]() ![]() ![]() ![]() ICQ: 262809473 Вопросов: 17 Ответов: 561 |
Web-сайт: Профиль | Цитата | #1 | Добавлено: 29.08.06 18:56 |
Когда - то давно написал. Если немного криво - сам поправь.
На UC закинь два лабела: Lbl & Lbl2 А вот код: Dim m_Font As Font
Dim m_FirstColor As OLE_COLOR Dim m_SecondColor As OLE_COLOR Dim m_BackColor As OLE_COLOR Dim m_intErval As Integer Const m_def_FirstColor = vb3DDKShadow Const m_def_SecondColor = vb3DHighlight Const m_def_BackColor = vbButtonFace Const m_def_inTerval = 1 Event Click() Event DblClick() Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) Private Sub lbl_Change() UserControl_Resize End Sub Private Sub lbl_Click() RaiseEvent Click End Sub Private Sub lbl_DblClick() RaiseEvent DblClick End Sub Private Sub lbl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) RaiseEvent MouseDown(Button, Shift, X, Y) End Sub Private Sub lbl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) RaiseEvent MouseMove(Button, Shift, X, Y) End Sub Private Sub lbl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) RaiseEvent MouseUp(Button, Shift, X, Y) End Sub Private Sub UserControl_Initialize() UserControl_Resize End Sub Private Sub UserControl_InitProperties() Caption = Ambient.DisplayName Enabled = True Set Font = UserControl.Ambient.Font FirstColor = m_def_FirstColor SecondColor = m_def_SecondColor BackColor = m_def_BackColor Interval = m_def_inTerval End Sub Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) RaiseEvent MouseDown(Button, Shift, X, Y) End Sub Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) RaiseEvent MouseMove(Button, Shift, X, Y) End Sub Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) RaiseEvent MouseUp(Button, Shift, X, Y) End Sub Private Sub UserControl_ReadProperties(PropBag As PropertyBag) Enabled = PropBag.ReadProperty("Enabled", True) Set Font = PropBag.ReadProperty("Font", UserControl.Ambient.Font) FirstColor = PropBag.ReadProperty("FirstColor", m_def_FirstColor) SecondColor = PropBag.ReadProperty("SecondColor", m_def_SecondColor) BackColor = PropBag.ReadProperty("BackColor", m_def_BackColor) Interval = PropBag.ReadProperty("Interval", m_def_inTerval) Caption = PropBag.ReadProperty("Caption", Ambient.DisplayName) End Sub Private Sub UserControl_Resize() On Error Resume Next UserControl.Height = Lbl.Height + (15 * Interval) UserControl.Width = Lbl.Width + (15 * Interval) Call UserControl_Show End Sub Public Property Get Enabled() As Boolean Enabled = UserControl.Enabled End Property Public Property Let Enabled(ByVal New_Enabled As Boolean) UserControl.Enabled() = New_Enabled PropertyChanged "Enabled" End Property Private Sub UserControl_Show() Lbl.Top = 0 Lbl.Left = 0 Lbl2.Top = 15 * Interval Lbl2.Left = 15 * Interval Lbl2.Caption = Lbl.Caption End Sub Private Sub UserControl_WriteProperties(PropBag As PropertyBag) On Error Resume Next Call PropBag.WriteProperty("Caption", Lbl.Caption, Ambient.DisplayName) Call PropBag.WriteProperty("Enabled", UserControl.Enabled, True) Call PropBag.WriteProperty("Font", m_Font, UserControl.Ambient.Font) Call PropBag.WriteProperty("FirstColor", m_FirstColor, m_def_FirstColor) Call PropBag.WriteProperty("SecondColor", m_SecondColor, m_def_SecondColor) Call PropBag.WriteProperty("BackColor", m_BackColor, m_def_BackColor) Call PropBag.WriteProperty("Interval", m_intErval, m_def_inTerval) End Sub Public Property Get Font() As Font Set Font = m_Font End Property Public Property Set Font(ByVal vNewFont As Font) Set m_Font = vNewFont Set UserControl.Font = vNewFont Set Lbl.Font = m_Font Set Lbl2.Font = m_Font Call UserControl_Resize PropertyChanged "Font" End Property Public Property Get FirstColor() As OLE_COLOR FirstColor = m_FirstColor End Property Public Property Get SecondColor() As OLE_COLOR SecondColor = m_SecondColor End Property Public Property Get BackColor() As OLE_COLOR BackColor = m_BackColor End Property Public Property Get Interval() As Integer Interval = m_intErval End Property Public Property Let FirstColor(ByVal New_FirstColor As OLE_COLOR) m_FirstColor = New_FirstColor PropertyChanged "FirstColor" Lbl.ForeColor = m_FirstColor UserControl_Resize End Property Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR) m_BackColor = New_BackColor PropertyChanged "BackColor" UserControl.BackColor = m_BackColor UserControl_Resize End Property Public Property Let SecondColor(ByVal New_SecondColor As OLE_COLOR) m_SecondColor = New_SecondColor PropertyChanged "SecondColor" Lbl2.ForeColor = m_SecondColor UserControl_Resize End Property Public Property Let Interval(ByVal New_Interval As Integer) m_intErval = New_Interval PropertyChanged "Interval" UserControl_Resize End Property Public Property Get Caption() As String Caption = Lbl.Caption End Property Public Property Let Caption(ByVal vNewCaption As String) Lbl.Caption() = vNewCaption Call UserControl_Resize PropertyChanged "Caption" End Property С тебя бутылка ![]() |
Номер ответа: 2 Автор ответа: ![]() ![]() ![]() ICQ: 298826769 Вопросов: 53 Ответов: 1732 |
Профиль | Цитата | #2 | Добавлено: 29.08.06 18:58 |
А те два лабела в лом на форме разместить? с разным ZOrder? |
Номер ответа: 3 Автор ответа: ![]() ![]() ![]() ![]() ![]() ![]() Разработчик Offline Client ICQ: 233286456 Вопросов: 34 Ответов: 5445 |
Web-сайт: Профиль | Цитата | #3 | Добавлено: 29.08.06 19:04 |
2 лэйбла на UC кинуть влом и написать 8 строчек ресайза и проперти ![]() |
Номер ответа: 4 Автор ответа: ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() Разработчик Offline Client Вопросов: 236 Ответов: 8362 |
Профиль | Цитата | #4 | Добавлено: 29.08.06 21:05 |
А те два лабела в лом на форме разместить? с разным ZOrder?
На форме ~ 15 лабелов, веришь, каждому Zorder, цвет, позицию - влом. Поскольку писать свой влом ещё больше, я и просил готовый, за что и спасибо Серёге. |
Номер ответа: 5 Автор ответа: ![]() ![]() ![]() ![]() Вопросов: 246 Ответов: 3333 |
Web-сайт: Профиль | Цитата | #5 | Добавлено: 30.08.06 13:24 |
HACKER, ты чаво?
Берешь, у всех лейблов делаешь какой-нибудь Tag, например, "ГАВ", чтоб прогой можно было отличить, затем создаешь еще один лейбл, делаешь его Visible = False и Index = 0, Name = "TEN" Дальше пишешь: Dim C As Control Dim I As Integer For Each C In Controls If C.Tag = "ГАВ" Then I = Ten.Count Load Ten(I) 'Создаем новую "тень" I.Left = C.Left + 100 'Заставляем тень касарезить за тем, от чего она отбрасывается I.Top = C.Top + 100 I.Width = C.Width I.Height = C.Height I.Caption = C.Caption I.ForeColor = RGB(128, 128, 128) 'Тень серго цвета I.Zorder vbSendToBack 'И находится с зади End If Next C |
Номер ответа: 6 Автор ответа: ![]() ![]() ![]() ![]() Вопросов: 246 Ответов: 3333 |
Web-сайт: Профиль | Цитата | #6 | Добавлено: 30.08.06 13:26 |
Извиняюсь за гору опечаток))))))))) Код:
Dim C As Control Dim I As Integer For Each C In Controls If C.Tag = "ГАВ" Then I = Ten.Count Load Ten(I) 'Создаем новую "тень" I.Left = C.Left + 100 'Заставляем тень касарезить за тем, от чего она отбрасывается Ten(I).Top = C.Top + 100 Ten(I).Width = C.Width Ten(I).Height = C.Height Ten(I).Caption = C.Caption Ten(I).ForeColor = RGB(128, 128, 128) 'Тень серго цвета Ten(I).Zorder vbSendToBack 'И находится с зади End If Next C |
Номер ответа: 7 Автор ответа: ![]() ![]() ![]() ![]() Вопросов: 246 Ответов: 3333 |
Web-сайт: Профиль | Цитата | #7 | Добавлено: 30.08.06 13:26 |
I.Left = C.Left + 100 - имелось тоже ввиду Ten(I) ![]() |
Номер ответа: 8 Автор ответа: ![]() ![]() ![]() ICQ: 262613583 Вопросов: 6 Ответов: 19 |
Профиль | Цитата | #8 | Добавлено: 30.08.06 17:35 |
да Серега изложил кульно вечером попробую свое сделать! |
Страница: 1 |
|