Visual Basic, .NET, ASP, VBScript
 

   
   
     

Форум - Общий форум

Страница: 1 |

 

  Вопрос: Нужен Label с тенью Добавлено: 29.08.06 18:28  

Автор вопроса:  HACKER
Писать влом что-то :) Дайте готовый...
искал в инете, несколько ocx'ов нашёл, но нах мне ocx'ы. Надо UserControl...

Ответить

  Ответы Всего ответов: 8  

Номер ответа: 1
Автор ответа:
 Серёга



ICQ: 262809473 

Вопросов: 17
Ответов: 561
 Web-сайт: houselab.narod.ru
 Профиль | | #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
Автор ответа:
 Arseny



ICQ: 298826769 

Вопросов: 53
Ответов: 1732
 Профиль | | #2 Добавлено: 29.08.06 18:58
А те два лабела в лом на форме разместить? с разным ZOrder?

Ответить

Номер ответа: 3
Автор ответа:
 sne



Разработчик Offline Client

ICQ: 233286456 

Вопросов: 34
Ответов: 5445
 Web-сайт: hw.t-k.ru
 Профиль | | #3
Добавлено: 29.08.06 19:04
2 лэйбла на UC кинуть влом и написать 8 строчек ресайза и проперти :) ?

Ответить

Номер ответа: 4
Автор ответа:
 HACKER


 

Разработчик Offline Client

Вопросов: 236
Ответов: 8362
 Профиль | | #4 Добавлено: 29.08.06 21:05
А те два лабела в лом на форме разместить? с разным ZOrder?


На форме ~ 15 лабелов, веришь, каждому Zorder, цвет, позицию - влом.

Поскольку писать свой влом ещё больше, я и просил готовый, за что и спасибо Серёге.

Ответить

Номер ответа: 5
Автор ответа:
 VβÐUηìt



Вопросов: 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
Автор ответа:
 VβÐUηìt



Вопросов: 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
Автор ответа:
 VβÐUηìt



Вопросов: 246
Ответов: 3333
 Web-сайт: смекаешь.рф
 Профиль | | #7
Добавлено: 30.08.06 13:26
I.Left = C.Left + 100 - имелось тоже ввиду Ten(I) :)))))))))))))))))))))))))))))))))))))))))))))))))))))))

Ответить

Номер ответа: 8
Автор ответа:
 XtremaL jon



ICQ: 262613583 

Вопросов: 6
Ответов: 19
 Профиль | | #8 Добавлено: 30.08.06 17:35
да Серега изложил кульно вечером попробую свое сделать!

Ответить

Страница: 1 |

Поиск по форуму



© Copyright 2002-2011 VBNet.RU | Пишите нам