panel3d.ctl

来自「图形界面面板」· CTL 代码 · 共 876 行 · 第 1/2 页

  End With
End Sub

Public Property Get Caption() As String
Attribute Caption.VB_Description = "标题文本"
Attribute Caption.VB_ProcData.VB_Invoke_Property = ";外观"
Attribute Caption.VB_UserMemId = -518
Attribute Caption.VB_MemberFlags = "200"
  Caption = mCaption
End Property

Public Property Let Caption(ByVal vNewValue As String)
  mCaption = vNewValue
  Refresh
  PropertyChanged "Caption"
End Property

Public Property Get RLCaption() As String
Attribute RLCaption.VB_ProcData.VB_Invoke_Property = "ppgRLCaption;外观"
  RLCaption = mRLCaption
End Property

Public Property Let RLCaption(ByVal vNewValue As String)
  mRLCaption = vNewValue
  Refresh
  PropertyChanged "RLCaption"
End Property

Public Property Get Alignment() As PositionConstants
Attribute Alignment.VB_Description = "文本对齐方式"
Attribute Alignment.VB_ProcData.VB_Invoke_Property = ";杂项"
  Alignment = mAlignment
End Property

Public Property Let Alignment(ByVal vNewValue As PositionConstants)
  If Between(vNewValue, posLeftTop, posRightBottom) Then
    mAlignment = vNewValue
    Refresh
    PropertyChanged "Alignment"
  End If
End Property

Public Property Get Font3D() As Font3DConstants
Attribute Font3D.VB_Description = "文本字体的三维效果"
Attribute Font3D.VB_ProcData.VB_Invoke_Property = ";字体"
  Font3D = mFont3D
End Property

Public Property Let Font3D(ByVal vNewValue As Font3DConstants)
  If Between(vNewValue, 0, 9) Then
    mFont3D = vNewValue
    Refresh
    PropertyChanged "Font3D"
  End If
End Property

Public Property Get ForeColor() As OLE_COLOR
Attribute ForeColor.VB_Description = "标题文本的前景颜色"
Attribute ForeColor.VB_ProcData.VB_Invoke_Property = ";外观"
Attribute ForeColor.VB_UserMemId = -513
  ForeColor = mForeColor
End Property

Public Property Let ForeColor(ByVal vNewValue As OLE_COLOR)
  mForeColor = vNewValue
  Refresh
  PropertyChanged "ForeColor"
End Property

Public Property Get OutLine() As Boolean
Attribute OutLine.VB_Description = "有/无外框"
Attribute OutLine.VB_ProcData.VB_Invoke_Property = ";外观"
  OutLine = mOutLine
End Property

Public Property Let OutLine(ByVal vNewValue As Boolean)
  mOutLine = vNewValue
  Refresh
  PropertyChanged "OutLine"
End Property

Public Property Get BevelInner() As Control3DConstants
Attribute BevelInner.VB_Description = "内层凹/凸效果"
Attribute BevelInner.VB_ProcData.VB_Invoke_Property = ";外观"
  BevelInner = mBevelInner
End Property

Public Property Let BevelInner(ByVal vNewValue As Control3DConstants)
  mBevelInner = vNewValue
  Refresh
  PropertyChanged "BevelInner"
End Property

Public Property Get BevelOuter() As Control3DConstants
Attribute BevelOuter.VB_Description = "外层凹/凸效果"
Attribute BevelOuter.VB_ProcData.VB_Invoke_Property = ";外观"
  BevelOuter = mBevelOuter
End Property

Public Property Let BevelOuter(ByVal vNewValue As Control3DConstants)
  mBevelOuter = vNewValue
  Refresh
  PropertyChanged "BevelOuter"
End Property

Public Property Get BevelWidth() As Integer
Attribute BevelWidth.VB_Description = "内外层凹/凸宽度"
Attribute BevelWidth.VB_ProcData.VB_Invoke_Property = ";外观"
  BevelWidth = mBevelWidth
End Property

Public Property Let BevelWidth(ByVal vNewValue As Integer)
  If vNewValue >= 1 Then
    mBevelWidth = vNewValue
    Refresh
    PropertyChanged "BevelWidth"
  End If
End Property

Public Property Get BorderWidth() As Integer
Attribute BorderWidth.VB_Description = "边框(内外层间部分)宽度"
Attribute BorderWidth.VB_ProcData.VB_Invoke_Property = ";外观"
Attribute BorderWidth.VB_UserMemId = -505
  BorderWidth = mBorderWidth
End Property

Public Property Let BorderWidth(ByVal vNewValue As Integer)
  If vNewValue >= 0 Then
    mBorderWidth = vNewValue
    Refresh
    PropertyChanged "BorderWidth"
  End If
End Property

Private Sub Box3D(ByVal BevelStyle As Control3DConstants, ByVal nBevel As Integer)
  Dim I As Integer
  Dim LTColor As OLE_COLOR
  Dim BRColor As OLE_COLOR
  
  On Error Resume Next
  
  Select Case BevelStyle
    Case c3dNone
      nBevel = 0
    Case c3dInsert
      LTColor = &H808080 Or DisabledColor
      BRColor = &HFFFFFF Or DisabledColor
    Case c3dRaised
      LTColor = &HFFFFFF Or DisabledColor
      BRColor = &H808080 Or DisabledColor
  End Select
  
  For I = 1 To nBevel
    UserControl.DrawWidth = 1
    UserControl.Line (L, T + H - 15)-Step(0, 15 - H), LTColor
    UserControl.Line -Step(W - 15, 0), LTColor
    UserControl.Line -Step(0, H - 15), BRColor
    UserControl.Line -Step(-W, 0), BRColor
    ReduceDrawArea 15
  Next I
End Sub

Private Sub ReduceDrawArea(ByVal Value As Integer)
  L = L + Value
  T = T + Value
  W = W - Value - Value
  H = H - Value - Value
End Sub

Public Property Get BorderColor() As OLE_COLOR
Attribute BorderColor.VB_Description = "边框(内外层间部分)颜色"
Attribute BorderColor.VB_ProcData.VB_Invoke_Property = ";外观"
Attribute BorderColor.VB_UserMemId = -503
  BorderColor = mBorderColor
End Property

Public Property Let BorderColor(ByVal vNewValue As OLE_COLOR)
  mBorderColor = vNewValue
  Refresh
  PropertyChanged "BorderColor"
End Property

Public Sub BoxBevel(ByVal nL As Integer, ByVal nT As Integer, ByVal nW As Integer, ByVal nH As Integer, ByVal nBevel As Integer)
  If nBevel <> 0 Then
    L = nL
    T = nT
    W = nW
    H = nH
    Box3D IIf(nBevel > 0, 2, 1), Abs(nBevel)
  End If
End Sub

Public Property Get Font() As Font
Attribute Font.VB_Description = "字体"
Attribute Font.VB_ProcData.VB_Invoke_Property = ";字体"
Attribute Font.VB_UserMemId = -512
  Set Font = UserControl.Font
End Property

Public Property Set Font(ByVal vNewValue As Font)
  On Error Resume Next
  Set UserControl.Font = vNewValue
  Refresh
  PropertyChanged "Font"
End Property

Public Property Get ShadowColor() As OLE_COLOR
Attribute ShadowColor.VB_Description = "使用ShadowAround三维特性时的阴影颜色"
Attribute ShadowColor.VB_ProcData.VB_Invoke_Property = ";外观"
  ShadowColor = mShadowColor
End Property

Public Property Let ShadowColor(ByVal vNewValue As OLE_COLOR)
  mShadowColor = vNewValue
  Refresh
  PropertyChanged "ShadowColor"
End Property

Public Property Get BackColor() As OLE_COLOR
Attribute BackColor.VB_Description = "背景颜色"
Attribute BackColor.VB_ProcData.VB_Invoke_Property = ";外观"
Attribute BackColor.VB_UserMemId = -501
  BackColor = mBackColor
End Property

Public Property Let BackColor(ByVal vNewValue As OLE_COLOR)
  mBackColor = vNewValue
  Refresh
  PropertyChanged "BackColor"
End Property

Public Property Get Version() As String
Attribute Version.VB_Description = "版本信息"
Attribute Version.VB_ProcData.VB_Invoke_Property = ";杂项"
  Version = cVersion
End Property

Public Property Let Version(ByVal vNewValue As String)
  '
End Property

Public Property Get Enabled() As Boolean
Attribute Enabled.VB_Description = "是否响应用户事件"
Attribute Enabled.VB_ProcData.VB_Invoke_Property = ";行为"
Attribute Enabled.VB_UserMemId = -514
  Enabled = mEnabled
End Property

Public Property Let Enabled(ByVal vNewValue As Boolean)
  mEnabled = vNewValue
  If UserControl.Ambient.UserMode Then UserControl.Enabled = mEnabled
  Refresh
  PropertyChanged "Enabled"
End Property

Public Property Get Visible() As Boolean
Attribute Visible.VB_Description = "是否可见"
Attribute Visible.VB_ProcData.VB_Invoke_Property = ";行为"
  Visible = mVisible
End Property

Public Property Let Visible(ByVal vNewValue As Boolean)
  mVisible = vNewValue
  PropertyChanged "Visible"
End Property

Private Function RoundToPixel(ByVal Value As Single) As Integer
  RoundToPixel = ((Value + 14) \ 15) * 15
End Function

Public Property Get FontName() As String
Attribute FontName.VB_MemberFlags = "400"
  FontName = UserControl.FontName
End Property

Public Property Let FontName(ByVal vNewValue As String)
  On Error Resume Next
  UserControl.FontName = vNewValue
  Refresh
  PropertyChanged "Font"
End Property

Public Property Get FontSize() As Single
Attribute FontSize.VB_MemberFlags = "400"
  FontSize = UserControl.FontSize
End Property

Public Property Let FontSize(ByVal vNewValue As Single)
  On Error Resume Next
  UserControl.FontSize = vNewValue
  Refresh
  PropertyChanged "Font"
End Property

Public Property Get FontBold() As Boolean
Attribute FontBold.VB_MemberFlags = "400"
  FontBold = UserControl.FontBold
End Property

Public Property Let FontBold(ByVal vNewValue As Boolean)
  UserControl.FontBold = vNewValue
  Refresh
  PropertyChanged "Font"
End Property

Public Property Get FontStrikethru() As Boolean
Attribute FontStrikethru.VB_MemberFlags = "400"
  FontStrikethru = UserControl.FontStrikethru
End Property

Public Property Let FontStrikethru(ByVal vNewValue As Boolean)
  UserControl.FontStrikethru = vNewValue
  Refresh
  PropertyChanged "Font"
End Property

Public Property Get FontUnderline() As Boolean
Attribute FontUnderline.VB_MemberFlags = "400"
  FontUnderline = UserControl.FontUnderline
End Property

Public Property Let FontUnderline(ByVal vNewValue As Boolean)
  UserControl.FontUnderline = vNewValue
  Refresh
  PropertyChanged "Font"
End Property

Public Property Get FontItalic() As Boolean
Attribute FontItalic.VB_MemberFlags = "400"
  FontItalic = UserControl.FontItalic
End Property

Public Property Let FontItalic(ByVal vNewValue As Boolean)
  UserControl.FontItalic = vNewValue
  Refresh
  PropertyChanged "Font"
End Property

Public Property Let Percents(ByVal vNewValue As Integer)
  If Not Between(vNewValue, 0, 100) Then vNewValue = 0
  mPercents = vNewValue
  Caption = IIf(mPercents > 0, mPercents & "%", "")
End Property

Public Property Get FloodColor() As OLE_COLOR
  FloodColor = mFloodColor
End Property

Public Property Let FloodColor(ByVal vNewValue As OLE_COLOR)
  mFloodColor = vNewValue
  Refresh
  PropertyChanged "FloodColor"
End Property

Private Function Between(ByVal Value, ByVal V1, ByVal V2) As Boolean
  Between = (Value >= V1) And (Value <= V2)
End Function

Public Property Get RichLabel() As Boolean
  RichLabel = mRichLabel
End Property

Public Property Let RichLabel(ByVal vNewValue As Boolean)
  mRichLabel = vNewValue
  Refresh
  PropertyChanged "RichLabel"
End Property

Public Property Get WordBorderDistance() As Integer
  WordBorderDistance = mWordBorderDistance
End Property

Public Property Let WordBorderDistance(ByVal vNewValue As Integer)
  If WordBorderDistance >= 0 Then
    mWordBorderDistance = vNewValue
    Refresh
    PropertyChanged "WordBorderDistance"
  End If
End Property

Public Property Get LinesDistance() As Integer
  LinesDistance = mLinesDistance
End Property

Public Property Let LinesDistance(ByVal vNewValue As Integer)
  If LinesDistance >= 0 Then
    mLinesDistance = vNewValue
    Refresh
    PropertyChanged "LinesDistance"
  End If
End Property
Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  RaiseEvent MouseDown(Button, Shift, X, Y)
End Sub

Public Property Get Align() As Integer
Attribute Align.VB_Description = "返回/设置一个值，决定对象在窗体上的显示位置。"
  Align = mAlign
End Property

Public Property Let Align(ByVal New_Align As Integer)
  mAlign = New_Align
  PropertyChanged "Align"
End Property

Private Sub UserControl_Click()
  RaiseEvent Click
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

Public Property Get MousePointer() As Integer
Attribute MousePointer.VB_Description = "返回/设置当鼠标经过对象某一部分时鼠标的指针类型。"
  MousePointer = UserControl.MousePointer
End Property

Public Property Let MousePointer(ByVal New_MousePointer As Integer)
  UserControl.MousePointer() = New_MousePointer
  PropertyChanged "MousePointer"
End Property

Public Property Get MouseIcon() As Picture
Attribute MouseIcon.VB_Description = "设置一个自定义鼠标图标。"
  Set MouseIcon = UserControl.MouseIcon
End Property

Public Property Set MouseIcon(ByVal New_MouseIcon As Picture)
  Set UserControl.MouseIcon = New_MouseIcon
  PropertyChanged "MouseIcon"
End Property

Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  RaiseEvent MouseUp(Button, Shift, X, Y)
End Sub