如何使自己编写的某些控件不受XPManifest控件控制
发布网友
发布时间：2022-04-22 21:35
共1个回答
热心网友
时间：2023-10-25 05:21
很简单的一个进度条控件，新建一个ocx工程，在里面添加一个picturebox控件，然后拷贝代码
编译成ocx控件，在使用的时候，设置font属性就出错，代码如下：
Public Enum BorderStyleConst
[无边框] = 0
[有边框] = 1
End Enum
Public Enum AppearanceConst
[扁平] = 0
[立体] = 1
End Enum
Public Enum CaptionAlignment
[左对齐] = 0
[右对齐] = 1
[居中对齐] = 2
End Enum
Private m_Value As Double
Private m_MaxValue As Double
Private m_MinValue As Double
Private m_Caption As String
Private m_Font As StdFont
Private m_CaptionPos As CaptionAlignment
'控件句柄
Public Property Get hWnd()
hWnd = Picture1.hWnd
End Property
'边框类型
Public Property Let BoderStyle(BoderStyle As BorderStyleConst)
Picture1.BorderStyle = BoderStyle
PropertyChanged "BoderStyle"
End Property
Public Property Get BoderStyle() As BorderStyleConst
BoderStyle = Picture1.BorderStyle
End Property
'外观类型
Public Property Let Appearance(Appearance As AppearanceConst)
Picture1.Appearance = Appearance
PropertyChanged "Appearance"
End Property
Public Property Get Appearance() As AppearanceConst
Appearance = Picture1.Appearance
End Property
'最大值
Public Property Let MaxValue(MaxVal As Double)
m_MaxValue = MaxVal
PropertyChanged "MaxValue"
End Property
Public Property Get MaxValue() As Double
MaxValue = m_MaxValue
End Property
'最小值
Public Property Let MinValue(MinVal As Double)
m_MinValue = MinVal
PropertyChanged "MinValue"
End Property
Public Property Get MinValue() As Double
MinValue = m_MinValue
End Property
'当前值
Public Property Let Value(Val As Double)
If m_Value > m_MaxValue Or Value < m_MinValue Then
MsgBox "当前进度值超出许可范围", vbExclamation
Else
m_Value = Val
DrawProgressBar
PropertyChanged "Value"
End If
End Property
Public Property Get Value() As Double
Value = m_Value
End Property
'进度条背景颜色
Public Property Let BackColor(BackColor As OLE_COLOR)
Picture1.BackColor = BackColor
PropertyChanged "BackColor"
End Property
Public Property Get BackColor() As OLE_COLOR
BackColor = Picture1.BackColor
End Property
'进度条颜色
Public Property Let FillColor(Color As OLE_COLOR)
Picture1.FillColor = Color
PropertyChanged "FillColor"
End Property
Public Property Get FillColor() As OLE_COLOR
FillColor = Picture1.FillColor
End Property
'进度条文字颜色
Public Property Let ForeColor(ForeColor As OLE_COLOR)
Picture1.ForeColor = ForeColor
DrawProgressBar
PropertyChanged "ForeColor"
End Property
Public Property Get ForeColor() As OLE_COLOR
ForeColor = Picture1.ForeColor
End Property
'当前显示的文字
Public Property Let Caption(Caption As String)
m_Caption = Caption
DrawProgressBar
PropertyChanged "Caption"
End Property
Public Property Get Caption() As String
Caption = m_Caption
End Property
'文字对齐
Public Property Let CaptionAlignment(Align As CaptionAlignment)
m_CaptionPos = Align
DrawProgressBar
PropertyChanged "CaptionAlignment"
End Property
Public Property Get CaptionAlignment() As CaptionAlignment
CaptionAlignment = m_CaptionPos
End Property
'文字字体
Public Property Let Font(New_Font As StdFont)
Set Picture1.Font = New_Font
DrawProgressBar
PropertyChanged "Font"
End Property
Public Property Get Font() As StdFont
Set Font = Picture1.Font
End Property
Private Sub UserControl_Initialize()
m_MaxValue = 100
m_MinValue = 0
PropertyChanged "MaxValue"
PropertyChanged "MinValue"
End Sub
Private Sub UserControl_InitProperties()
Dim pFont As New StdFont
With pFont
.Name = "宋体"
.Size = 2
End With
Set Picture1.Font = pFont
End Sub
Private Sub UserControl_Resize()
On Error Resume Next
Picture1.Move UserControl.ScaleLeft, UserControl.ScaleTop, UserControl.ScaleWidth, UserControl.ScaleHeight
DrawProgressBar
End Sub
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
Dim pFont As New StdFont
With pFont
.Name = "宋体"
.Size = 10
End With
Set Picture1.Font = PropBag.ReadProperty("Font", pFont)
Picture1.Appearance = PropBag.ReadProperty("Appearance", 1)
Picture1.BorderStyle = PropBag.ReadProperty("BorderStyle", 1)
Picture1.BackColor = PropBag.ReadProperty("BackColor", vbWhite)
Picture1.ForeColor = PropBag.ReadProperty("ForeColor", vbRed)
Picture1.FillColor = PropBag.ReadProperty("FillColor", vbBlue)
m_Caption = PropBag.ReadProperty("Caption", "0")
m_CaptionPos = PropBag.ReadProperty("CaptionAlign", 2)
m_MaxValue = PropBag.ReadProperty("MaxValue", 100)
m_MinValue = PropBag.ReadProperty("MinValue", 0)
End Sub
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
Call PropBag.WriteProperty("Font", Picture1.Font, Ambient.Font)
PropBag.WriteProperty "BorderStyle", Picture1.BorderStyle
PropBag.WriteProperty "Appearance", Picture1.Appearance
PropBag.WriteProperty "BackColor", Picture1.BackColor, vbWhite
PropBag.WriteProperty "ForeColor", Picture1.ForeColor, vbBlue
PropBag.WriteProperty "FillColor", Picture1.FillColor, vbBlack
PropBag.WriteProperty "Caption", m_Caption, ""
PropBag.WriteProperty "CaptionAlign", m_CaptionPos, 2
PropBag.WriteProperty "MaxValue", m_MaxValue, 100
PropBag.WriteProperty "MinValue", m_MinValue, 0
End Sub
Private Sub DrawProgressBar()
Dim w As Long
Dim h As Long
Dim strText As String
Dim mLeft As Long
Dim mTop As Long
Picture1.Cls
a = (m_Value * 100) / m_MaxValue
b = ((Picture1.Width * a) / 100)
Picture1.Line (0, 0)-(b, Picture1.Height), Picture1.FillColor, BF
h = Picture1.TextHeight(m_Caption)
w = Picture1.TextWidth(m_Caption)
mTop = (Picture1.ScaleHeight - h) / 2
If m_CaptionPos = 居中对齐 Then
mLeft = (Picture1.ScaleWidth - w) / 2
ElseIf m_CaptionPos = 右对齐 Then
mLeft = Picture1.ScaleWidth - w
ElseIf m_CaptionPos = 左对齐 Then
mLeft = 0
End If
Picture1.CurrentX = mLeft
Picture1.CurrentY = mTop
Picture1.Print m_Caption
End Sub
