imagebutton.ctl

一个日程管理和通讯录管理的软件

VERSION 5.00
Begin VB.UserControl ImageButton 
   AutoRedraw      =   -1  'True
   ClientHeight    =   2010
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   2745
   ScaleHeight     =   2010
   ScaleWidth      =   2745
   Begin VB.Line BottomLine 
      X1              =   270
      X2              =   900
      Y1              =   900
      Y2              =   900
   End
   Begin VB.Line LeftLine 
      BorderColor     =   &H00E0E0E0&
      X1              =   270
      X2              =   270
      Y1              =   315
      Y2              =   810
   End
   Begin VB.Line RightLine 
      BorderColor     =   &H00404040&
      X1              =   945
      X2              =   945
      Y1              =   315
      Y2              =   855
   End
   Begin VB.Line TopLine 
      BorderColor     =   &H80000005&
      X1              =   315
      X2              =   855
      Y1              =   270
      Y2              =   270
   End
   Begin VB.Image Image1 
      Appearance      =   0  'Flat
      Height          =   500
      Left            =   1087
      Stretch         =   -1  'True
      Top             =   743
      Width           =   570
   End
End
Attribute VB_Name = "ImageButton"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
'缺省属性值:
Const m_def_Caption = "ImageButton"
Public Event Click()
'属性变量:
Dim m_Caption As String


'注意！不要删除或修改下列被注释的行！
'MappingInfo=UserControl,UserControl,-1,BackColor
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

'注意！不要删除或修改下列被注释的行！
'MappingInfo=UserControl,UserControl,-1,ForeColor
Public Property Get ForeColor() As OLE_COLOR
    ForeColor = UserControl.ForeColor
End Property

Public Property Let ForeColor(ByVal New_ForeColor As OLE_COLOR)
    UserControl.ForeColor() = New_ForeColor
    PropertyChanged "ForeColor"
End Property

'注意！不要删除或修改下列被注释的行！
'MappingInfo=Image1,Image1,-1,Picture
Public Property Get Picture() As Picture
Attribute Picture.VB_Description = "返回/设置控件中显示的图形。"
    Set Picture = Image1.Picture
End Property

Public Property Set Picture(ByVal New_Picture As Picture)
    Set Image1.Picture = New_Picture
    PropertyChanged "Picture"
End Property
Private Sub Image1_Click()
    RaiseEvent Click
End Sub

Private Sub Image1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    TopLine.BorderColor = &H80000008
    BottomLine.BorderColor = &H80000005
    LeftLine.BorderColor = &H404040
    RightLine.BorderColor = &H80000005
End Sub

Private Sub Image1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Image1.MousePointer = 99
    TopLine.Visible = True
    BottomLine.Visible = True
    LeftLine.Visible = True
    RightLine.Visible = True
End Sub

Private Sub Image1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    TopLine.BorderColor = &H80000005
    BottomLine.BorderColor = &H80000008
    LeftLine.BorderColor = &HE0E0E0
    RightLine.BorderColor = &H404040
End Sub

Private Sub UserControl_Initialize()
    TopLine.Visible = False
    BottomLine.Visible = False
    LeftLine.Visible = False
    RightLine.Visible = False
End Sub

'为用户控件初始化属性
Private Sub UserControl_InitProperties()
    m_Caption = m_def_Caption
End Sub

Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    UserControl.MousePointer = 0
    LeftLine.Visible = False
    RightLine.Visible = False
    TopLine.Visible = False
    BottomLine.Visible = False
End Sub

'从存贮器中加载属性值
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)

    UserControl.BackColor = PropBag.ReadProperty("BackColor", &H8000000F)
    UserControl.ForeColor = PropBag.ReadProperty("ForeColor", &H80000012)
    Set Picture = PropBag.ReadProperty("Picture", Nothing)
    Set MouseIcon = PropBag.ReadProperty("MouseIcon", Nothing)
    m_Caption = PropBag.ReadProperty("Caption", m_def_Caption)
End Sub

Private Sub UserControl_Resize()
    Cls
    UserControl.ScaleMode = 2
    Image1.Move (UserControl.ScaleWidth - Image1.Width) / 2, (UserControl.ScaleHeight - Image1.Height) / 2
    TopLine.X1 = Image1.Left - 2
    TopLine.X2 = TopLine.X1 + Image1.Width + 4
    TopLine.Y1 = Image1.Top - 2
    TopLine.Y2 = Image1.Top - 2
    RightLine.X1 = TopLine.X1 + Image1.Width + 4
    RightLine.X2 = TopLine.X1 + Image1.Width + 4
    RightLine.Y1 = Image1.Top - 2
    RightLine.Y2 = Image1.Height + 3 + LeftLine.BorderWidth + Image1.Top
    LeftLine.X1 = Image1.Left - 2
    LeftLine.X2 = Image1.Left - 2
    LeftLine.Y1 = Image1.Top - 2
    LeftLine.Y2 = Image1.Height + 3 + Image1.Top
    BottomLine.X1 = Image1.Left - 2
    BottomLine.X2 = TopLine.X1 + Image1.Width + 4
    BottomLine.Y1 = Image1.Height + 3 + Image1.Top
    BottomLine.Y2 = Image1.Height + 3 + Image1.Top
    
    'UserControl.Height = Image1.Height + TextHeight(Caption) + LeftLine.BorderWidth + 5
    CurrentX = (UserControl.ScaleWidth - TextWidth(Caption)) / 2
    CurrentY = Image1.Height + LeftLine.BorderWidth + 6 + Image1.Top
    Print Caption
End Sub

Private Sub UserControl_Show()
    CurrentX = (UserControl.ScaleWidth - TextWidth(Caption)) / 2
    CurrentY = Image1.Height + LeftLine.BorderWidth + 6 + Image1.Top
    Print Caption
End Sub

'将属性值写到存储器
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)

    Call PropBag.WriteProperty("BackColor", UserControl.BackColor, &H8000000F)
    Call PropBag.WriteProperty("ForeColor", UserControl.ForeColor, &H80000012)
    Call PropBag.WriteProperty("Picture", Picture, Nothing)
    Call PropBag.WriteProperty("BorderWidth", LeftLine.BorderWidth, 1)
    Call PropBag.WriteProperty("MouseIcon", MouseIcon, Nothing)
    Call PropBag.WriteProperty("Caption", m_Caption, m_def_Caption)
End Sub
'注意！不要删除或修改下列被注释的行！
'MappingInfo=Image1,Image1,-1,MouseIcon
Public Property Get MouseIcon() As Picture
Attribute MouseIcon.VB_Description = "设置一个自定义鼠标图标。"
    Set MouseIcon = Image1.MouseIcon
End Property

Public Property Set MouseIcon(ByVal New_MouseIcon As Picture)
    Set Image1.MouseIcon = New_MouseIcon
    PropertyChanged "MouseIcon"
End Property
'注意！不要删除或修改下列被注释的行！
'MemberInfo=14,1,0,0
Public Property Get Caption() As Variant
    Caption = m_Caption
End Property

Public Property Let Caption(ByVal New_Caption As Variant)
    'If Ambient.UserMode Then Err.Raise 382
    m_Caption = New_Caption
    PropertyChanged "Caption"
End Property