|
Листинг 10
UserControl: FigCtrl Option Explicit Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, _ ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As POINTAPI, _ ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long Private Type POINTAPI X As Long Y As Long End Type Private rgn() As POINTAPI Private FirstAdding As Boolean Private rgnItemX() As Long Private rgnItemY() As Long Public Enum constOrientation Horizontal = 0 Vertical = 1 End Enum Const m_def_Caption = "FigureControl" Const m_def_ForeColor = &HFFFF& Const m_def_Gradient = True Const m_def_GradientRed = 0 Const m_def_GradientGreen = 0 Const m_def_GradientBlue = -1 Const m_def_GradientOrientation = 0 Const m_def_BorderColor = &H808080 Const m_def_BorderThickness = 2 Dim m_Caption As String Dim m_ForeColor As OLE_COLOR Dim m_BorderColor As OLE_COLOR Dim m_BorderThickness As Integer Dim m_Gradient As Boolean Dim m_GradientRed As Integer Dim m_GradientGreen As Integer Dim m_GradientBlue As Integer Dim m_GradientOrientation As constOrientation Event Click() 'MappingInfo=UserControl,UserControl,-1,Click Event DblClick() 'MappingInfo=UserControl,UserControl,-1,DblClick Event KeyDown(KeyCode As Integer, Shift As Integer) 'MappingInfo=UserControl,UserControl,-1,KeyDown Event KeyPress(KeyAscii As Integer) 'MappingInfo=UserControl,UserControl,-1,KeyPress Event KeyUp(KeyCode As Integer, Shift As Integer) 'MappingInfo=UserControl,UserControl,-1,KeyUp Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=UserControl,UserControl,-1,MouseDown Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=UserControl,UserControl,-1,MouseMove Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=UserControl,UserControl,-1,MouseUp '***************Private********************************* Private Function PointCount() As Integer PointCount = UBound(rgnItemX) End Function Private Sub DrawControl() Cls If m_Gradient = True Then Dim R%, G%, B% Dim i%, NbrRects%, GradValue%, GradColor& NbrRects% = 127 ScaleMode = 3 DrawWidth = 2 DrawStyle = 6 AutoRedraw = True For i = 1 To NbrRects GradValue = 255 - (i * 2 - 1) If m_GradientRed = -1 Then R = GradValue Else R = m_GradientRed End If If m_GradientGreen = -1 Then G = GradValue Else G = m_GradientGreen End If If m_GradientBlue = -1 Then B = GradValue Else B = m_GradientBlue End If 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 CurrentY = (ScaleHeight - TextHeight(m_Caption)) / 2 UserControl.ForeColor = m_ForeColor UserControl.Print m_Caption ShowFigure End Sub '*******************Method****************************** Public Sub AddPoint(ByVal X As Long, ByVal Y As Long) Dim i As Integer i = UBound(rgnItemX) If FirstAdding Then i = 0 FirstAdding = False Else i = i + 1 End If ReDim Preserve rgnItemX(i) ReDim Preserve rgnItemY(i) rgnItemX(i) = X rgnItemY(i) = Y End Sub Public Sub Refresh() UserControl.Refresh End Sub Public Sub ShowFigure() Dim i As Integer, count As Long, hRgn As Long On Error Resume Next count = PointCount + 1 ReDim rgn(count) As POINTAPI For i = 1 To count rgn(i).X = rgnItemX(i - 1) rgn(i).Y = rgnItemY(i - 1) Next hRgn = CreatePolygonRgn(rgn(1), count, 0) SetWindowRgn UserControl.hWnd, hRgn, True DrawWidth = m_BorderThickness For i = 1 To count If i = count Then Line (rgn(i).X, rgn(i).Y)-(rgn(1).X, rgn(1).Y), m_BorderColor Else Line (rgn(i).X, rgn(i).Y)-(rgn(i + 1).X, rgn(i + 1).Y), m_BorderColor End If Next End Sub Public Sub About() frmAbout.Show vbModal End Sub '**********************Event*************************** Private Sub UserControl_Click() RaiseEvent Click End Sub Private Sub UserControl_DblClick() RaiseEvent DblClick End Sub Private Sub UserControl_KeyDown(KeyCode As Integer, Shift As Integer) RaiseEvent KeyDown(KeyCode, Shift) End Sub Private Sub UserControl_KeyPress(KeyAscii As Integer) RaiseEvent KeyPress(KeyAscii) End Sub Private Sub UserControl_KeyUp(KeyCode As Integer, Shift As Integer) RaiseEvent KeyUp(KeyCode, Shift) 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 '************************Properties ********************** 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 PropertyChanged "BackColor" 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 PropertyChanged "Gradient" DrawControl End Property Public Property Get GradientRed() As Integer GradientRed = m_GradientRed End Property Public Property Let GradientRed(ByVal New_GradientRed As Integer) If New_GradientRed < 0 Or New_GradientRed > 255 Then New_GradientRed = -1 End If m_GradientRed = New_GradientRed PropertyChanged "GradientRed" DrawControl End Property Public Property Get GradientGreen() As Integer GradientGreen = m_GradientGreen End Property Public Property Let GradientGreen(ByVal New_GradientGreen As Integer) If New_GradientGreen < 0 Or New_GradientGreen > 255 Then New_GradientGreen = -1 End If m_GradientGreen = New_GradientGreen PropertyChanged "GradientGreen" DrawControl End Property Public Property Get GradientBlue() As Integer GradientBlue = m_GradientBlue End Property Public Property Let GradientBlue(ByVal New_GradientBlue As Integer) If New_GradientBlue < 0 Or New_GradientBlue > 255 Then New_GradientBlue = -1 End If m_GradientBlue = New_GradientBlue PropertyChanged "GradientBlue" DrawControl 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 PropertyChanged "GradientOrientation" DrawControl End Property Public Property Get BorderColor() As OLE_COLOR BorderColor = m_BorderColor End Property Public Property Let BorderColor(ByVal New_BorderColor As OLE_COLOR) m_BorderColor = New_BorderColor PropertyChanged "BorderColor" End Property Public Property Get BorderThickness() As Integer BorderThickness = m_BorderThickness End Property Public Property Let BorderThickness(ByVal New_BorderThickness As Integer) m_BorderThickness = New_BorderThickness PropertyChanged "BorderThickness" 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 PropertyChanged "Caption" DrawControl 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 PropertyChanged "Font" DrawControl 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 PropertyChanged "ForeColor" DrawControl End Property '***************UserControl Properties******************** Private Sub UserControl_Initialize() ReDim rgnItemX(0) ReDim rgnItemY(0) FirstAdding = True End Sub Private Sub UserControl_InitProperties() m_Gradient = m_def_Gradient m_GradientRed = m_def_GradientRed m_GradientGreen = m_def_GradientGreen m_GradientBlue = m_def_GradientBlue m_GradientOrientation = m_def_GradientOrientation m_BorderColor = m_def_BorderColor m_BorderThickness = m_def_BorderThickness m_Caption = m_def_Caption m_ForeColor = m_def_ForeColor Set UserControl.Font = Ambient.Font End Sub Private Sub UserControl_ReadProperties(PropBag As PropertyBag) UserControl.BackColor = PropBag.ReadProperty("BackColor", &HFFFFC0) m_Gradient = PropBag.ReadProperty("Gradient", m_def_Gradient) m_GradientRed = PropBag.ReadProperty("GradientRed", m_def_GradientRed) m_GradientGreen = PropBag.ReadProperty("GradientGreen", m_def_GradientGreen) m_GradientBlue = PropBag.ReadProperty("GradientBlue", m_def_GradientBlue) m_GradientOrientation = _ PropBag.ReadProperty("GradientOrientation", m_def_GradientOrientation) m_BorderColor = PropBag.ReadProperty("BorderColor", m_def_BorderColor) m_BorderThickness = PropBag.ReadProperty("BorderThickness", m_def_BorderThickness) Set UserControl.Font = PropBag.ReadProperty("Font", Ambient.Font) m_ForeColor = PropBag.ReadProperty("ForeColor", &H80000012) m_Caption = PropBag.ReadProperty("Caption", m_def_Caption) 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("BackColor", UserControl.BackColor, &HFFFFC0) Call PropBag.WriteProperty("Gradient", m_Gradient, m_def_Gradient) Call PropBag.WriteProperty("GradientRed", m_GradientRed, m_def_GradientRed) Call PropBag.WriteProperty("GradientGreen", m_GradientGreen, m_def_GradientGreen) Call PropBag.WriteProperty("GradientBlue", m_GradientBlue, m_def_GradientBlue) Call PropBag.WriteProperty("GradientOrientation", _ m_GradientOrientation, m_def_GradientOrientation) Call PropBag.WriteProperty("BorderColor", m_BorderColor, m_def_BorderColor) Call PropBag.WriteProperty("BorderThickness", m_BorderThickness, m_def_BorderThickness) Call PropBag.WriteProperty("Font", UserControl.Font, Ambient.Font) Call PropBag.WriteProperty("ForeColor", m_ForeColor, &H80000012) Call PropBag.WriteProperty("Caption", m_Caption, m_def_Caption) End Sub Property Page: ppFigureControl Option Explicit Private Sub cboGradientOrientation_Click() Changed = True End Sub Private Sub chkBlue_Click() scrBlue.Enabled = Not (-1 * chkBlue.Value) If chkBlue.Value = 1 Then lblBlue.Caption = -1 Else lblBlue.Caption = scrBlue.Value End If Changed = True End Sub Private Sub chkGreen_Click() scrGreen.Enabled = Not (-1 * chkGreen.Value) If chkGreen.Value = 1 Then lblGreen.Caption = -1 Else lblGreen.Caption = scrGreen.Value End If Changed = True End Sub Private Sub chkRed_Click() scrRed.Enabled = Not (-1 * chkRed.Value) If chkRed.Value = 1 Then lblRed.Caption = -1 Else lblRed.Caption = scrRed.Value End If Changed = True End Sub Private Sub scrBlue_Change() lblBlue.Caption = scrBlue.Value Changed = True End Sub Private Sub scrGreen_Change() lblGreen.Caption = scrGreen.Value Changed = True End Sub Private Sub scrRed_Change() lblRed.Caption = scrRed.Value Changed = True End Sub Private Sub chkGradient_Click() Changed = True End Sub Private Sub txtBorderThickness_Change() Changed = True End Sub Private Sub txtCaption_Change() Changed = True End Sub Private Sub PropertyPage_ApplyChanges() SelectedControls(0).GradientBlue = lblBlue.Caption SelectedControls(0).GradientGreen = lblGreen.Caption SelectedControls(0).GradientRed = lblRed.Caption SelectedControls(0).Gradient = (chkGradient.Value = vbChecked) SelectedControls(0).GradientOrientation = cboGradientOrientation.ListIndex SelectedControls(0).Caption = txtCaption.Text SelectedControls(0).BorderThickness = txtBorderThickness.Text End Sub Private Sub PropertyPage_SelectionChanged() Select Case SelectedControls(0).GradientBlue Case -1 chkBlue.Value = 1 Case Else chkBlue.Value = 0 scrBlue.Value = SelectedControls(0).GradientBlue End Select Select Case SelectedControls(0).GradientGreen Case -1 chkGreen.Value = 1 Case Else chkGreen.Value = 0 scrGreen.Value = SelectedControls(0).GradientGreen End Select Select Case SelectedControls(0).GradientRed Case -1 chkRed.Value = 1 Case Else chkRed.Value = 0 scrRed.Value = SelectedControls(0).GradientRed End Select chkGradient.Value = (SelectedControls(0).Gradient And vbChecked) cboGradientOrientation.Text = cboGradientOrientation.List(SelectedControls(0).GradientOrientation) txtCaption.Text = SelectedControls(0).Caption txtBorderThickness.Text = SelectedControls(0).BorderThickness End Sub
|
