11-2.ctl

vb6.0编程实例详解,很详细的介绍,对学习VB有帮助

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.UserControl UserButton 
   ClientHeight    =   600
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   1350
   ScaleHeight     =   600
   ScaleWidth      =   1350
   Begin MSComctlLib.ImageList ImageList1 
      Left            =   0
      Top             =   0
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   90
      ImageHeight     =   40
      MaskColor       =   12632256
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
         NumListImages   =   2
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "11-2.ctx":0000
            Key             =   "Down"
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "11-2.ctx":2AD4
            Key             =   "Up"
         EndProperty
      EndProperty
   End
   Begin VB.Image Pic1 
      Height          =   495
      Left            =   600
      Stretch         =   -1  'True
      Top             =   0
      Width           =   615
   End
End
Attribute VB_Name = "UserButton"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function PtInRegion Lib "gdi32" (ByVal hRgn As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Public Event Click() '定义控件事件
Private m_Width As Single
Private m_Height As Single
Private m_Activing As Boolean


Private Sub Pic1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 1 Then
    '按钮左键按下
        If CheckPoint(Int(X), Int(Y)) Then
            Pic1.Picture = ImageList1.ListImages("Down").Picture
            m_Activing = True '设置动作标记
        End If
    End If
End Sub

Private Sub Pic1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If m_Activing Then
        If CheckPoint(Int(X), Int(Y)) Then
        '鼠标位置在椭圆内
            Pic1.Picture = ImageList1.ListImages("Down").Picture
        Else
            Pic1.Picture = ImageList1.ListImages("Up").Picture
        End If
    End If
End Sub

Private Sub Pic1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Pic1.Picture = ImageList1.ListImages("Up").Picture
    If m_Activing And CheckPoint(Int(X), Int(Y)) Then
        RaiseEvent Click '触发事件
    End If
    m_Activing = False
End Sub

Private Sub UserControl_Initialize()
    Pic1.Picture = ImageList1.ListImages("Up").Picture
    m_Width = Width '保存窗体大小
    m_Height = Height
End Sub

Private Sub UserControl_Resize()
    Width = m_Width '恢复窗体大小
    Height = m_Height
    '设置图片大小
    With Pic1
        .Top = ScaleTop
        .Left = ScaleLeft
        .Width = ScaleWidth
        .Height = ScaleHeight
    End With
End Sub

Private Function CheckPoint(X As Long, Y As Long) As Boolean
    Dim hRgn As Long
    Dim stat, i As Integer

    '创建椭圆资源
    hRgn = CreateEllipticRgn(Pic1.Left, Pic1.Top, Pic1.Left + Pic1.Width, Pic1.Top + Pic1.Height)
    '检测输入点位置
    CheckPoint = PtInRegion(hRgn, X, Y)
    '释放多边形资源
    stat = DeleteObject(hRgn)
End Function