label.ctl

自制标签文件。可以增加系统的标签没有的功能

VERSION 5.00
Begin VB.UserControl Label 
   ClientHeight    =   3600
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   4800
   ScaleHeight     =   3600
   ScaleWidth      =   4800
   ToolboxBitmap   =   "Label.ctx":0000
End
Attribute VB_Name = "Label"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

Const def_ID = ""
Const def_NameColor = &HFFFFFF

Dim m_ID As String
Dim H As Double
Dim W As Double
Dim m_NameColor As OLE_COLOR
Dim m_ShowID As Boolean
Dim m_DispType As Boolean

Private Sub UserControl_AmbientChanged(PropertyName As String)
   UserControl.BackColor = UserControl.Ambient.BackColor
End Sub

Private Sub UserControl_Initialize()
   m_ID = def_ID
   m_NameColor = def_NameColor
   m_ShowID = True
End Sub


'显示名称
Public Property Get ID() As String
   ID = m_ID
End Property

Public Property Let ID(ByVal vNewValue As String)
   If Ambient.UserMode = False Then
      m_ID = vNewValue
      PropertyChanged "ID"
      UserControl_Resize
      UserControl.Refresh
      
   End If
End Property


'显示字体大小
Public Property Get Font() As Font
   Set Font = UserControl.Font
End Property

Public Property Set Font(ByVal vNewValue As Font)
   Set UserControl.Font = vNewValue
    PropertyChanged "Font"
    UserControl_Resize
    UserControl.Refresh
    
End Property

Public Property Get NameColor() As OLE_COLOR
   NameColor = m_NameColor
End Property

Public Property Let NameColor(ByVal vNewValue As OLE_COLOR)
   m_NameColor = vNewValue
   PropertyChanged "NameColor"
   UserControl.Refresh
End Property

Private Sub UserControl_Paint()
   ForeColor = m_NameColor
   UserControl.CurrentX = 50
   UserControl.CurrentY = 10
   If m_ShowID Or m_DispType Then Print m_ID
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
   UserControl.BackColor = PropBag.ReadProperty("BackColor", &H8000000F)
   Set UserControl.Font = PropBag.ReadProperty("Font", Ambient.Font)
   m_ID = PropBag.ReadProperty("ID", def_ID)
   m_NameColor = PropBag.ReadProperty("NameColor", def_NameColor)
End Sub

Private Sub UserControl_Resize()
   UserControl.Width = IIf((TextWidth(m_ID) - 300) > 0, TextWidth(m_ID) + 100, 300)
   UserControl.Height = IIf((TextHeight(m_ID) - 100) > 0, TextHeight(m_ID) + 20, 100)
   H = UserControl.Height
   W = UserControl.Width
   
End Sub

Private Sub UserControl_Show()
   UserControl.BackColor = UserControl.Ambient.BackColor
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
   Call PropBag.WriteProperty("BackColor", UserControl.BackColor, &H8000000F)
   Call PropBag.WriteProperty("Font", UserControl.Font, Ambient.Font)
   Call PropBag.WriteProperty("ID", m_ID, def_ID)
   Call PropBag.WriteProperty("NameColor", m_NameColor, def_NameColor)
End Sub

Public Sub Refresh()
    UserControl.Refresh
End Sub

Public Property Get ShowID() As Boolean
    
    ShowID = m_ShowID
   
End Property

Public Property Let ShowID(ByVal New_ShowID As Boolean)
   m_ShowID = New_ShowID
   PropertyChanged "ShowID"
   UserControl.Refresh
End Property


Public Property Get DispType() As Boolean
   DispType = m_DispType
End Property

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