www.pudn.com > VBkongjian.rar > checkbox.ctl
VERSION 5.00
Object = "{27395F88-0C0C-101B-A3C9-08002B2F49FB}#1.1#0"; "PICCLP32.OCX"
Begin VB.UserControl NiceCheck
AccessKeys = "&H00C0C0FF&"
AutoRedraw = -1 'True
BackColor = &H00E0E0E0&
ClientHeight = 3060
ClientLeft = 0
ClientTop = 0
ClientWidth = 8385
FillStyle = 0 'Solid
ScaleHeight = 3060
ScaleWidth = 8385
ToolboxBitmap = "checkbox.ctx":0000
Begin VB.Timer Timer1
Interval = 10
Left = 240
Top = 960
End
Begin VB.PictureBox p
Appearance = 0 'Flat
AutoSize = -1 'True
BackColor = &H80000005&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 240
Left = 240
ScaleHeight = 16
ScaleMode = 3 'Pixel
ScaleWidth = 16
TabIndex = 1
Top = 120
Width = 240
End
Begin PicClip.PictureClip pc
Index = 0
Left = 120
Top = 480
_ExtentX = 344
_ExtentY = 4128
_Version = 393216
Rows = 12
Picture = "checkbox.ctx":0312
End
Begin PicClip.PictureClip pc
Index = 1
Left = 360
Top = 480
_ExtentX = 344
_ExtentY = 4128
_Version = 393216
Rows = 12
Picture = "checkbox.ctx":1BC4
End
Begin PicClip.PictureClip pc
Index = 2
Left = 600
Top = 480
_ExtentX = 344
_ExtentY = 4128
_Version = 393216
Rows = 12
Picture = "checkbox.ctx":3476
End
Begin PicClip.PictureClip pc
Index = 3
Left = 840
Top = 480
_ExtentX = 344
_ExtentY = 4128
_Version = 393216
Rows = 12
Picture = "checkbox.ctx":4D28
End
Begin PicClip.PictureClip pc
Index = 4
Left = 1080
Top = 480
_ExtentX = 344
_ExtentY = 4128
_Version = 393216
Rows = 12
Picture = "checkbox.ctx":65DA
End
Begin PicClip.PictureClip pc
Index = 5
Left = 1320
Top = 480
_ExtentX = 344
_ExtentY = 4128
_Version = 393216
Rows = 12
Picture = "checkbox.ctx":7E8C
End
Begin PicClip.PictureClip pc
Index = 6
Left = 1560
Top = 480
_ExtentX = 344
_ExtentY = 4128
_Version = 393216
Rows = 12
Picture = "checkbox.ctx":973E
End
Begin PicClip.PictureClip pc
Index = 7
Left = 1800
Top = 480
_ExtentX = 344
_ExtentY = 4128
_Version = 393216
Rows = 12
Picture = "checkbox.ctx":AFF0
End
Begin PicClip.PictureClip pc
Index = 8
Left = 2040
Top = 480
_ExtentX = 344
_ExtentY = 4128
_Version = 393216
Rows = 12
Picture = "checkbox.ctx":C8A2
End
Begin PicClip.PictureClip pc
Index = 9
Left = 2280
Top = 480
_ExtentX = 344
_ExtentY = 4128
_Version = 393216
Rows = 12
Picture = "checkbox.ctx":E154
End
Begin PicClip.PictureClip pc
Index = 10
Left = 2520
Top = 480
_ExtentX = 344
_ExtentY = 4128
_Version = 393216
Rows = 12
Picture = "checkbox.ctx":FA06
End
Begin PicClip.PictureClip pc
Index = 11
Left = 2760
Top = 480
_ExtentX = 344
_ExtentY = 4128
_Version = 393216
Rows = 12
Picture = "checkbox.ctx":112B8
End
Begin PicClip.PictureClip pc
Index = 12
Left = 3000
Top = 480
_ExtentX = 344
_ExtentY = 4128
_Version = 393216
Rows = 12
Picture = "checkbox.ctx":12B6A
End
Begin PicClip.PictureClip pc
Index = 13
Left = 3240
Top = 480
_ExtentX = 344
_ExtentY = 4128
_Version = 393216
Rows = 12
Picture = "checkbox.ctx":1441C
End
Begin PicClip.PictureClip pc
Index = 15
Left = 3720
Top = 480
_ExtentX = 344
_ExtentY = 4128
_Version = 393216
Rows = 12
Picture = "checkbox.ctx":15CCE
End
Begin PicClip.PictureClip pc
Index = 14
Left = 3480
Top = 480
_ExtentX = 344
_ExtentY = 4128
_Version = 393216
Rows = 12
Picture = "checkbox.ctx":17580
End
Begin PicClip.PictureClip pc
Index = 16
Left = 3960
Top = 480
_ExtentX = 344
_ExtentY = 4128
_Version = 393216
Rows = 12
Picture = "checkbox.ctx":18E32
End
Begin PicClip.PictureClip pc
Index = 17
Left = 4200
Top = 480
_ExtentX = 344
_ExtentY = 4128
_Version = 393216
Rows = 12
Picture = "checkbox.ctx":1A6E4
End
Begin PicClip.PictureClip pc
Index = 18
Left = 4440
Top = 480
_ExtentX = 344
_ExtentY = 4128
_Version = 393216
Rows = 12
Picture = "checkbox.ctx":1BF96
End
Begin PicClip.PictureClip pc
Index = 19
Left = 4680
Top = 480
_ExtentX = 344
_ExtentY = 4128
_Version = 393216
Rows = 12
Picture = "checkbox.ctx":1D848
End
Begin PicClip.PictureClip pc
Index = 20
Left = 4920
Top = 480
_ExtentX = 344
_ExtentY = 4128
_Version = 393216
Rows = 12
Picture = "checkbox.ctx":1F0FA
End
Begin PicClip.PictureClip pc
Index = 21
Left = 5160
Top = 480
_ExtentX = 344
_ExtentY = 4128
_Version = 393216
Rows = 12
Picture = "checkbox.ctx":209AC
End
Begin PicClip.PictureClip pc
Index = 22
Left = 5400
Top = 480
_ExtentX = 344
_ExtentY = 4128
_Version = 393216
Rows = 12
Picture = "checkbox.ctx":2225E
End
Begin PicClip.PictureClip pc
Index = 23
Left = 5640
Top = 480
_ExtentX = 344
_ExtentY = 4128
_Version = 393216
Rows = 12
Picture = "checkbox.ctx":23B10
End
Begin VB.Label lbl
Appearance = 0 'Flat
AutoSize = -1 'True
BackColor = &H80000005&
BackStyle = 0 'Transparent
Caption = "Check1"
ForeColor = &H80000008&
Height = 180
Left = 480
TabIndex = 0
Top = 120
Width = 540
End
End
Attribute VB_Name = "NiceCheck"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINT_API) As Long
Private Declare Function ScreenToClient Lib "user32" (ByVal hWnd As Long, lpPoint As POINT_API) As Long
Private Type POINT_API
X As Long
Y As Long
End Type
Public Enum State
Unchecked = 0
Checked = 1
Mixed = 2
End Enum
Dim m_Font As Font
Dim m_Value As State
Dim m_BackColor As OLE_COLOR
Dim m_ForeColor As OLE_COLOR
Const m_def_Value = State.Unchecked
Const m_def_BackColor = &HE0E0E0
Const m_def_ForeColor = vbBlack
Event Click()
Attribute Click.VB_UserMemId = -600
Event KeyDown(KeyCode As Integer, Shift As Integer)
Attribute KeyDown.VB_UserMemId = -602
Event KeyPress(KeyAscii As Integer)
Attribute KeyPress.VB_UserMemId = -603
Event KeyUp(KeyCode As Integer, Shift As Integer)
Attribute KeyUp.VB_UserMemId = -604
Event MouseOut()
Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Attribute MouseDown.VB_UserMemId = -605
Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Attribute MouseMove.VB_UserMemId = -606
Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Attribute MouseUp.VB_UserMemId = -607
'缺省属性值:
Const m_def_SkinIdx = 0
'属性变量:
Dim m_SkinIdx As Integer
Private Sub lbl_Change()
UserControl_Resize
End Sub
Private Sub lbl_Click()
Call UserControl_Click
End Sub
Private Sub lbl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call UserControl_MouseDown(Button, Shift, X, Y)
End Sub
Private Sub lbl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call UserControl_MouseMove(Button, Shift, lbl.Left, lbl.Top)
End Sub
Private Sub lbl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call UserControl_MouseUp(Button, Shift, X, Y)
End Sub
Private Sub p_Click()
UserControl_Click
End Sub
Private Sub p_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call UserControl_MouseDown(Button, Shift, X, Y)
End Sub
Private Sub p_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call UserControl_MouseMove(Button, Shift, X, Y)
End Sub
Private Sub p_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call UserControl_MouseUp(Button, Shift, X, Y)
End Sub
Private Sub Timer1_Timer()
Dim pnt As POINT_API
UserControl.ScaleMode = 3
GetCursorPos pnt
ScreenToClient UserControl.hWnd, pnt
If pnt.X < UserControl.ScaleLeft Or _
pnt.Y < UserControl.ScaleTop Or _
pnt.X > (UserControl.ScaleLeft + UserControl.ScaleWidth) Or _
pnt.Y > (UserControl.ScaleTop + UserControl.ScaleHeight) Then
define_pic
Timer1.Enabled = False
RaiseEvent MouseOut
End If
End Sub
Private Sub UserControl_Click()
RaiseEvent Click
If Value = Checked Then
Value = Unchecked
ElseIf Value = Unchecked Then
Value = Checked
ElseIf Value = Mixed Then
Value = Unchecked
End If
define_pic
End Sub
Private Sub UserControl_Initialize()
define_pic
UserControl_Resize
UserControl.BackColor = m_BackColor
'SavePicture pc(m_SkinIdx).Picture, "c:\a.bmp"
End Sub
Public Property Get Enabled() As Boolean
Attribute Enabled.VB_ProcData.VB_Invoke_Property = ";Behavior"
Attribute Enabled.VB_UserMemId = -514
Enabled = UserControl.Enabled
End Property
Public Property Let Enabled(ByVal New_Enabled As Boolean)
UserControl.Enabled() = New_Enabled
If Enabled = False Then
enabled_pic
Else: define_pic
End If
If Enabled = True Then lbl.ForeColor = m_ForeColor Else lbl.ForeColor = RGB(161, 161, 146)
End Property
Private Sub UserControl_InitProperties()
Caption = Ambient.DisplayName
Enabled = True
Value = Unchecked
Set Font = UserControl.Ambient.Font
BackColor = m_def_BackColor
ForeColor = m_def_ForeColor
m_SkinIdx = m_def_SkinIdx
End Sub
Private Sub UserControl_KeyDown(KeyCode As Integer, Shift As Integer)
RaiseEvent KeyDown(KeyCode, Shift)
End Sub
Private Sub UserControl_KeyPress(KeyAscii As Integer)
RaiseEvent KeyPress(KeyAscii)
End Sub
Private Sub UserControl_KeyUp(KeyCode As Integer, Shift As Integer)
RaiseEvent KeyUp(KeyCode, Shift)
End Sub
Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Enabled = True Then
If Value = Checked Then
p.Picture = pc(m_SkinIdx).GraphicCell(6)
ElseIf Value = Mixed Then
p.Picture = pc(m_SkinIdx).GraphicCell(10)
ElseIf Value = Unchecked Then
p.Picture = pc(m_SkinIdx).GraphicCell(2)
End If
End If
RaiseEvent MouseDown(Button, Shift, X, Y)
End Sub
Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Timer1.Enabled = True
If X >= 0 And Y >= 0 And _
X <= UserControl.ScaleWidth And Y <= UserControl.ScaleHeight Then
If Button = vbLeftButton Then
If Enabled = True Then
If Value = Checked Then
p.Picture = pc(m_SkinIdx).GraphicCell(6)
ElseIf Value = Mixed Then
p.Picture = pc(m_SkinIdx).GraphicCell(10)
ElseIf Value = Unchecked Then
p.Picture = pc(m_SkinIdx).GraphicCell(2)
End If
End If
Else
If Enabled = True Then
If Value = Checked Then
p.Picture = pc(m_SkinIdx).GraphicCell(5)
ElseIf Value = Mixed Then
p.Picture = pc(m_SkinIdx).GraphicCell(9)
ElseIf Value = Unchecked Then
p.Picture = pc(m_SkinIdx).GraphicCell(1)
End If
End If
End If
End If
RaiseEvent MouseMove(Button, Shift, X, Y)
End Sub
Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
RaiseEvent MouseUp(Button, Shift, X, Y)
End Sub
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
Value = PropBag.ReadProperty("Value", m_def_Value)
Caption = PropBag.ReadProperty("Caption", Ambient.DisplayName)
Enabled = PropBag.ReadProperty("Enabled", True)
Set Font = PropBag.ReadProperty("Font", UserControl.Ambient.Font)
BackColor = PropBag.ReadProperty("BackColor", m_def_BackColor)
ForeColor = PropBag.ReadProperty("ForeColor", m_def_ForeColor)
m_SkinIdx = PropBag.ReadProperty("SkinIdx", m_def_SkinIdx)
End Sub
Private Sub UserControl_Resize()
UserControl.ScaleMode = 1
p.Left = 0
p.Top = 0
lbl.Height = UserControl.Height + 100
lbl.Width = UserControl.Width
lbl.Top = p.Height / 2 - 100
lbl.Left = p.Width + 50
UserControl.Height = p.Height
End Sub
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
Call PropBag.WriteProperty("Font", m_Font, UserControl.Ambient.Font)
Call PropBag.WriteProperty("Value", m_Value, m_def_Value)
Call PropBag.WriteProperty("Caption", lbl.Caption, Ambient.DisplayName)
Call PropBag.WriteProperty("Enabled", UserControl.Enabled, True)
Call PropBag.WriteProperty("BackColor", m_BackColor, m_def_BackColor)
Call PropBag.WriteProperty("ForeColor", m_ForeColor, m_def_ForeColor)
Call PropBag.WriteProperty("SkinIdx", m_SkinIdx, m_def_SkinIdx)
End Sub
Public Property Get Value() As State
Value = m_Value
End Property
Public Property Let Value(ByVal vNewValue As State)
m_Value = vNewValue
define_pic
PropertyChanged "Value"
End Property
Public Property Get Caption() As String
Attribute Caption.VB_ProcData.VB_Invoke_Property = ";Appearance"
Attribute Caption.VB_UserMemId = -518
Caption = lbl.Caption
End Property
Public Property Let Caption(ByVal vNewCaption As String)
lbl.Caption() = vNewCaption
Call UserControl_Resize
PropertyChanged "Caption"
End Property
Public Property Get Font() As Font
Attribute Font.VB_ProcData.VB_Invoke_Property = ";Font"
Attribute Font.VB_UserMemId = -512
Set Font = m_Font
End Property
Public Property Set Font(ByVal vNewFont As Font)
Set m_Font = vNewFont
Set UserControl.Font = vNewFont
Set lbl.Font = m_Font
Call UserControl_Resize
PropertyChanged "Font"
End Property
Private Function define_pic()
If Enabled = True Then
If Value = Checked Then
p.Picture = pc(m_SkinIdx).GraphicCell(4)
ElseIf Value = Mixed Then
p.Picture = pc(m_SkinIdx).GraphicCell(8)
ElseIf Value = Unchecked Then
p.Picture = pc(m_SkinIdx).GraphicCell(0)
End If
Else: enabled_pic
End If
End Function
Private Function enabled_pic()
If Value = Checked Then
p.Picture = pc(m_SkinIdx).GraphicCell(7)
ElseIf Value = Mixed Then
p.Picture = pc(m_SkinIdx).GraphicCell(11)
ElseIf Value = Unchecked Then
p.Picture = pc(m_SkinIdx).GraphicCell(3)
End If
End Function
Public Property Get BackColor() As OLE_COLOR
Attribute BackColor.VB_ProcData.VB_Invoke_Property = ";Appearance"
Attribute BackColor.VB_UserMemId = -501
BackColor = m_BackColor
End Property
Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
m_BackColor = New_BackColor
PropertyChanged "BackColor"
UserControl.BackColor = m_BackColor
End Property
Public Property Get ForeColor() As OLE_COLOR
Attribute ForeColor.VB_ProcData.VB_Invoke_Property = ";Appearance"
Attribute ForeColor.VB_UserMemId = -513
ForeColor = m_ForeColor
End Property
Public Property Let ForeColor(ByVal New_ForeColor As OLE_COLOR)
m_ForeColor = New_ForeColor
PropertyChanged "ForeColor"
If Enabled = True Then lbl.ForeColor = m_ForeColor Else lbl.ForeColor = RGB(161, 161, 146)
End Property
'注意！不要删除或修改下列被注释的行！
'MemberInfo=7,0,0,0
Public Property Get Style() As MnuStyle
Attribute Style.VB_Description = "样式"
SkinIdx = m_SkinIdx
End Property
Public Property Let Style(ByVal New_SkinIdx As MnuStyle)
m_SkinIdx = New_SkinIdx
define_pic
PropertyChanged "SkinIdx"
End Property