|
Листинг 6
UserControl Panel
Option Explicit 'константы эмуляции объема Public Enum constVStyle Выпуклый = 0 Вдавленный = 1 End Enum 'константы направления градиентной заливки Public Enum constOrientation Горизонтальный = 0 Вертикальный = 1 End Enum 'константы цвета градиентной заливки Public Enum constBackColor Красно_Черный = 0 Желто_Черный = 1 Серо_Черный = 2 Зелено_Черный = 3 Бирюзово_Черный = 4 Cине_Черный = 5 Желто_Зеленый = 6 Розово_Синий = 7 Бело_Бирюзовый = 8 Бело_Голубой = 9 Бирюзово_Синий = 10 Желто_Красный = 11 Бело_Сиреневый = 12 Бело_Красный = 13 Сине_Зеленый = 14 Сиренево_Красный = 15 Бело_Желтый = 16 End Enum 'Значение свойств по-умолчанию: Const m_def_Gradient = False Const m_def_Caption = "Panel" Const m_def_BorderStyle = 0 Const m_def_GradientColor = 0 Const m_def_GradientOrientation = 0 Const m_def_FontStyle = 0 Const m_def_ForeColor = &H80000012 'Цвета теней для создания объема Const GREY = &H8000000C Const WHITE = &H80000009 'Переменные свойств: Dim m_Gradient As Boolean Dim m_Caption As String Dim m_BorderStyle As constVStyle Dim m_GradientColor As constBackColor Dim m_GradientOrientation As constOrientation Dim m_FontStyle As constVStyle Dim m_ForeColor As OLE_COLOR 'Объявление событий: Event Click() 'MappingInfo=UserControl,UserControl,-1,Click Event DblClick() 'MappingInfo=UserControl,UserControl,-1,DblClick Event MouseMove(Button As Integer, Shift As Integer, X As Single,
Y As Single) 'MappingInfo=UserControl,UserControl,-1,MouseMove Event MouseDown(Button As Integer, Shift As Integer, X As Single,
Y As Single) 'MappingInfo=UserControl,UserControl,-1,MouseDown Event MouseUp(Button As Integer, Shift As Integer, X As Single,
Y As Single) 'MappingInfo=UserControl,UserControl,-1,MouseUp Public Property Get BorderStyle() As constVStyle BorderStyle = m_BorderStyle End Property Public Property Let BorderStyle(ByVal New_BorderStyle As constVStyle) m_BorderStyle = New_BorderStyle DrawControl PropertyChanged "BorderStyle" End Property Public Property Get FontStyle() As constVStyle FontStyle = m_FontStyle End Property Public Property Let FontStyle(ByVal New_FontStyle As constVStyle) m_FontStyle = New_FontStyle DrawControl PropertyChanged "FontStyle" End Property Public Property Get Gradient() As Boolean Gradient = m_Gradient End Property Public Property Let Gradient(ByVal New_Gradient As Boolean) m_Gradient = New_Gradient DrawControl PropertyChanged "Gradient" End Property Public Property Get GradientColor() As constBackColor GradientColor = m_GradientColor End Property Public Property Let GradientColor(ByVal New_GradientColor
As constBackColor) m_GradientColor = New_GradientColor DrawControl PropertyChanged "GradientColor" End Property Public Property Get GradientOrientation() As constOrientation GradientOrientation = m_GradientOrientation End Property Public Property Let GradientOrientation(ByVal New_GradientOrientation
As constOrientation) m_GradientOrientation = New_GradientOrientation DrawControl PropertyChanged "GradientOrientation" End Property Public Property Get Caption() As String Caption = m_Caption End Property Public Property Let Caption(ByVal New_Caption As String) m_Caption = New_Caption DrawControl PropertyChanged "Caption" End Property Public Property Get Font() As Font Set Font = UserControl.Font End Property Public Property Set Font(ByVal New_Font As Font) Set UserControl.Font = New_Font DrawControl PropertyChanged "Font" End Property Public Property Get ForeColor() As OLE_COLOR ForeColor = m_ForeColor 'UserControl.ForeColor End Property Public Property Let ForeColor(ByVal New_ForeColor As OLE_COLOR) m_ForeColor = New_ForeColor DrawControl PropertyChanged "ForeColor" End Property Public Property Get BackColor() As OLE_COLOR BackColor = UserControl.BackColor End Property Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR) UserControl.BackColor() = New_BackColor DrawControl PropertyChanged "BackColor" End Property Private Sub DrawControl() Dim R%, G%, B% Dim i%, NbrRects%, GradValue%, GradColor& UserControl.Cls If m_Gradient = True Then NbrRects% = 128 For i = 1 To NbrRects GradValue = 255 - (i * 2 - 1) Select Case m_GradientColor Case 0 R = GradValue G = 0 B = 0 Case 1 R = GradValue G = GradValue B = 0 Case 2 R = GradValue G = GradValue B = GradValue Case 3 R = 0 G = GradValue B = 0 Case 4 R = 0 G = GradValue B = GradValue Case 5 R = 0 G = 0 B = GradValue Case 6 R = GradValue G = 255 B = 0 Case 7 R = GradValue G = 0 B = 255 Case 8 R = GradValue G = 255 B = 255 Case 9 R = GradValue G = GradValue B = 255 Case 10 R = 0 G = GradValue B = 255 Case 11 R = 255 G = GradValue B = 0 Case 12 R = 255 G = GradValue B = 255 Case 13 R = 255 G = GradValue B = GradValue Case 14 R = 0 G = 255 B = GradValue Case 15 R = 255 G = 0 B = GradValue Case 16 R = 255 G = 255 B = GradValue Case Else 'если по ошибке поставят < 0 или > 16 R = 0 G = 0 B = GradValue End Select GradColor = RGB(R, G, B) Select Case m_GradientOrientation Case 0 Line (0, ScaleHeight * (i - 1) / NbrRects)-(ScaleWidth, ScaleHeight *
i / NbrRects), GradColor&, BF Case 1 Line (ScaleWidth * (i - 1) / NbrRects, 0)-(ScaleWidth * i / NbrRects,
ScaleHeight), GradColor&, BF Case Else 'если по ошибке поставят < 0 или > 1 Line (0, ScaleHeight * (i - 1) / NbrRects)-(ScaleWidth, ScaleHeight *
i / NbrRects), GradColor&, BF End Select Next i End If CurrentX = (ScaleWidth - TextWidth(m_Caption)) / 2 - 0.5 CurrentY = (ScaleHeight - TextHeight(m_Caption)) / 2 - 0.5 If m_FontStyle = Выпуклый Then UserControl.ForeColor = WHITE Else UserControl.ForeColor = GREY End If UserControl.Print m_Caption CurrentX = (ScaleWidth - TextWidth(m_Caption)) / 2 + 1 CurrentY = (ScaleHeight - TextHeight(m_Caption)) / 2 + 1 If m_FontStyle = Выпуклый Then UserControl.ForeColor = GREY ElseUserControl.ForeColor = WHITE End If UserControl.Print m_Caption CurrentX = (ScaleWidth - TextWidth(m_Caption)) / 2 CurrentY = (ScaleHeight - TextHeight(m_Caption)) / 2 UserControl.ForeColor = m_ForeColor UserControl.Print m_Caption Select Case m_BorderStyle Case Вдавленный Line (0, 0)-(0, ScaleHeight - 1), GREY Line -(ScaleWidth - 1, ScaleHeight - 1), WHITE Line -(ScaleWidth - 1, 0), WHITE Line -(0, 0), GREY Case Выпуклый Line (0, 0)-(0, ScaleHeight - 1), WHITE Line -(ScaleWidth - 1, ScaleHeight - 1), GREY Line -(ScaleWidth - 1, 0), GREY Line -(0, 0), WHITE End Select End Sub 'Инициализация свойств для контрола Private Sub UserControl_InitProperties() m_BorderStyle = m_def_BorderStyle m_GradientColor = m_def_GradientColor m_GradientOrientation = m_def_GradientOrientation Set UserControl.Font = Ambient.Font m_Gradient = m_def_Gradient m_Caption = m_def_Caption m_FontStyle = m_def_FontStyle m_ForeColor = m_def_ForeColor End Sub 'Загрузка значений свойств Private Sub UserControl_ReadProperties(PropBag As PropertyBag) m_BorderStyle = PropBag.ReadProperty("BorderStyle", m_def_BorderStyle) m_GradientColor = PropBag.ReadProperty("GradientColor", m_def_GradientColor) m_GradientOrientation = PropBag.ReadProperty("GradientOrientation",
m_def_GradientOrientation) Set UserControl.Font = PropBag.ReadProperty("Font", Ambient.Font) m_ForeColor = PropBag.ReadProperty("ForeColor", &H80000012) UserControl.BackColor = PropBag.ReadProperty("BackColor", &H8000000F) m_Gradient = PropBag.ReadProperty("Gradient", m_def_Gradient) m_Caption = PropBag.ReadProperty("Caption", m_def_Caption) m_FontStyle = PropBag.ReadProperty("FontStyle", m_def_FontStyle) End Sub Private Sub UserControl_Resize() DrawControl End Sub Private Sub UserControl_Show() DrawControl End Sub 'Запись значений свойств Private Sub UserControl_WriteProperties(PropBag As PropertyBag) Call PropBag.WriteProperty("BorderStyle", m_BorderStyle, m_def_BorderStyle) Call PropBag.WriteProperty("GradientColor", m_GradientColor, m_def_GradientColor) Call PropBag.WriteProperty("GradientOrientation", m_GradientOrientation,
m_def_GradientOrientation) Call PropBag.WriteProperty("Font", UserControl.Font, Ambient.Font) Call PropBag.WriteProperty("ForeColor", m_ForeColor, &H80000012) Call PropBag.WriteProperty("BackColor", UserControl.BackColor, &H8000000F) Call PropBag.WriteProperty("Gradient", m_Gradient, m_def_Gradient) Call PropBag.WriteProperty("Caption", m_Caption, m_def_Caption) Call PropBag.WriteProperty("FontStyle", m_FontStyle, m_def_FontStyle) End Sub Private Sub UserControl_Click() RaiseEvent Click End Sub Private Sub UserControl_DblClick() RaiseEvent DblClick 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_MouseDown(Button As Integer, Shift As Integer, X As Single,
Y As Single) RaiseEvent MouseDown(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 'Загрузка формы About с окна свойств Public Sub About() frmAbout.Show vbModal End Sub PropertyPage Genelal Option Explicit Private Sub cboBorderStyle_Click() Changed = True End Sub Private Sub cboFontStyle_Click() Changed = True End Sub Private Sub cboGradientColor_Click() Changed = True End Sub Private Sub cboGradientOrientation_Click() Changed = True End Sub Private Sub txtCaption_Change() Changed = True End Sub Private Sub chkGradient_Click() Changed = True End Sub Private Sub PropertyPage_ApplyChanges() SelectedControls(0).Caption = txtCaption.Text SelectedControls(0).Gradient = (chkGradient.Value = vbChecked) SelectedControls(0).GradientOrientation = cboGradientOrientation.ListIndex SelectedControls(0).GradientColor = cboGradientColor.ListIndex SelectedControls(0).BorderStyle = cboBorderStyle.ListIndex SelectedControls(0).FontStyle = cboFontStyle.ListIndex End Sub Private Sub PropertyPage_SelectionChanged() cboGradientOrientation.Text = cboGradientOrientation.List
(SelectedControls(0).GradientOrientation) cboGradientColor.Text = cboGradientColor.List(SelectedControls(0).GradientColor) txtCaption.Text = SelectedControls(0).Caption chkGradient.Value = (SelectedControls(0).Gradient And vbChecked) cboBorderStyle.Text = cboBorderStyle.List(SelectedControls(0).BorderStyle) cboFontStyle.Text = cboFontStyle.List(SelectedControls(0).FontStyle) End Sub
|
