|
Листинг 4
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 rgnPts() As POINTAPI 'Default Property Values: Const m_def_Percent = vbNullString Const m_def_BasisColor = &HFF0000 Const m_def_SandColor = &H80FF& Const m_def_Min = 0 Const m_def_Max = 100 Const m_def_Value = 0 'Property Variables: Dim m_Percent As String Dim m_BasisColor As OLE_COLOR Dim m_SandColor As OLE_COLOR Dim m_Min As Long Dim m_Max As Long Dim m_Value As Long Private Sub UserControl_Resize() Dim hRgn&, numAngle& ScaleMode = 3 DrawWidth = 2 DrawStyle = 6 AutoRedraw = True numAngle = 17 ReDim rgnPts(0 To numAngle) As POINTAPI rgnPts(0).X = 0 rgnPts(0).Y = 0 rgnPts(1).X = ScaleWidth rgnPts(1).Y = 0 rgnPts(2).X = ScaleWidth rgnPts(2).Y = ScaleHeight * 0.1 rgnPts(3).X = ScaleWidth * 0.9 rgnPts(3).Y = ScaleHeight * 0.25 rgnPts(4).X = ScaleWidth * 0.7 rgnPts(4).Y = ScaleHeight * 0.45 rgnPts(5).X = ScaleWidth * 0.55 rgnPts(5).Y = ScaleHeight * 0.5 rgnPts(6).X = ScaleWidth * 0.7 rgnPts(6).Y = ScaleHeight * 0.55 rgnPts(7).X = ScaleWidth * 0.9 rgnPts(7).Y = ScaleHeight * 0.75 rgnPts(8).X = ScaleWidth rgnPts(8).Y = ScaleHeight * 0.9 rgnPts(9).X = ScaleWidth rgnPts(9).Y = ScaleHeight rgnPts(10).X = 0 rgnPts(10).Y = ScaleHeight rgnPts(11).X = 0 rgnPts(11).Y = ScaleHeight * 0.9 rgnPts(12).X = ScaleWidth * 0.1 rgnPts(12).Y = ScaleHeight * 0.75 rgnPts(13).X = ScaleWidth * 0.3 rgnPts(13).Y = ScaleHeight * 0.55 rgnPts(14).X = ScaleWidth * 0.45 rgnPts(14).Y = ScaleHeight * 0.5 rgnPts(15).X = ScaleWidth * 0.3 rgnPts(15).Y = ScaleHeight * 0.45 rgnPts(16).X = ScaleWidth * 0.1 rgnPts(16).Y = ScaleHeight * 0.25 rgnPts(17).X = 0 rgnPts(17).Y = ScaleHeight * 0.1 hRgn = CreatePolygonRgn(rgnPts(0), numAngle + 1, 0) SetWindowRgn UserControl.hWnd, hRgn, True DrawControl End Sub Private Sub DrawControl() Cls ScaleMode = 3 DrawWidth = 2 DrawStyle = 6 AutoRedraw = True If m_Value <> m_Max Then Line (0, (m_Value - m_Min) * ScaleHeight * 0.5 / (m_Max - m_Min))-(ScaleWidth, ScaleHeight * 0.5), m_SandColor, BF Line (ScaleWidth * 0.45, ScaleHeight * 0.5)-(ScaleWidth * 0.54, ScaleHeight * 0.95), m_SandColor, BF Line (0, ScaleHeight - ((m_Value - m_Min) * ScaleHeight * 0.5 / (m_Max - m_Min)))-(ScaleWidth, ScaleHeight * 0.95), _ m_SandColor, BF End If Line (0, 0)-(ScaleWidth, ScaleHeight * 0.05), m_BasisColor, BF Line (0, ScaleHeight * 0.95)-(ScaleWidth, ScaleHeight), m_BasisColor, BF Line (ScaleWidth, 0)-(ScaleWidth, ScaleHeight * 0.1), m_BasisColor Line -(ScaleWidth * 0.9, ScaleHeight * 0.25), m_BasisColor Line -(ScaleWidth * 0.7, ScaleHeight * 0.45), m_BasisColor Line -(ScaleWidth * 0.55, ScaleHeight * 0.5), m_BasisColor Line -(ScaleWidth * 0.7, ScaleHeight * 0.55), m_BasisColor Line -(ScaleWidth * 0.9, ScaleHeight * 0.75), m_BasisColor Line -(ScaleWidth, ScaleHeight * 0.9), m_BasisColor Line -(ScaleWidth, ScaleHeight), m_BasisColor Line (0, ScaleHeight)-(0, ScaleHeight * 0.9), m_BasisColor Line -(ScaleWidth * 0.1, ScaleHeight * 0.75), m_BasisColor Line -(ScaleWidth * 0.3, ScaleHeight * 0.55), m_BasisColor Line -(ScaleWidth * 0.45, ScaleHeight * 0.5), m_BasisColor Line -(ScaleWidth * 0.3, ScaleHeight * 0.45), m_BasisColor Line -(ScaleWidth * 0.1, ScaleHeight * 0.25), m_BasisColor Line -(0, ScaleHeight * 0.1), m_BasisColor Line -(0, 0), m_BasisColor Refresh End Sub Public Property Get Value() As Long Value = m_Value End Property Public Property Let Value(ByVal New_Value As Long) m_Value = New_Value PropertyChanged "Value" DrawControl End Property Public Property Get Min() As Long Min = m_Min End Property Public Property Let Min(ByVal New_Min As Long) m_Min = New_Min PropertyChanged "Min" DrawControl End Property Public Property Get Max() As Long Max = m_Max End Property Public Property Let Max(ByVal New_Max As Long) m_Max = New_Max PropertyChanged "Max" DrawControl End Property Public Property Get Percent() As String Percent = Format((m_Value - m_Min) * 100 / (m_Max - m_Min), "0") & "%" 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 PropertyChanged "BackColor" DrawControl End Property Public Property Get BasisColor() As OLE_COLOR BasisColor = m_BasisColor End Property Public Property Let BasisColor(ByVal New_BasisColor As OLE_COLOR) m_BasisColor = New_BasisColor PropertyChanged "BasisColor" DrawControl End Property Public Property Get SandColor() As OLE_COLOR SandColor = m_SandColor End Property Public Property Let SandColor(ByVal New_SandColor As OLE_COLOR) m_SandColor = New_SandColor PropertyChanged "SandColor" DrawControl End Property 'Initialize Properties for User Control Private Sub UserControl_InitProperties() m_Min = m_def_Min m_Max = m_def_Max m_Value = m_def_Value m_SandColor = m_def_SandColor m_BasisColor = m_def_BasisColor m_Percent = m_def_Percent End Sub 'Load property values from storage Private Sub UserControl_ReadProperties(PropBag As PropertyBag) m_Min = PropBag.ReadProperty("Min", m_def_Min) m_Max = PropBag.ReadProperty("Max", m_def_Max) m_Value = PropBag.ReadProperty("Value", m_def_Value) UserControl.BackColor = PropBag.ReadProperty("BackColor", &HFFFFC0) m_SandColor = PropBag.ReadProperty("SandColor", m_def_SandColor) m_BasisColor = PropBag.ReadProperty("BasisColor", m_def_BasisColor) m_Percent = PropBag.ReadProperty("Percent", m_def_Percent) End Sub Private Sub UserControl_Show() BasisColor = m_BasisColor End Sub 'Write property values to storage Private Sub UserControl_WriteProperties(PropBag As PropertyBag) Call PropBag.WriteProperty("Min", m_Min, m_def_Min) Call PropBag.WriteProperty("Max", m_Max, m_def_Max) Call PropBag.WriteProperty("Value", m_Value, m_def_Value) Call PropBag.WriteProperty("BackColor", UserControl.BackColor, &HFFFFC0) Call PropBag.WriteProperty("SandColor", m_SandColor, m_def_SandColor) Call PropBag.WriteProperty("BasisColor", m_BasisColor, m_def_BasisColor) End Sub Public Sub About() frmAbout.Show vbModal End Sub
|
