?? hkd.ctl
字號:
VERSION 5.00
Begin VB.UserControl HKD
Appearance = 0 'Flat
BackColor = &H8000000B&
ClientHeight = 3600
ClientLeft = 0
ClientTop = 0
ClientWidth = 4800
ScaleHeight = 3600
ScaleWidth = 4800
Begin VB.Shape Shape1
BorderStyle = 0 'Transparent
Height = 1005
Left = 0
Top = 0
Width = 1470
End
Begin VB.Image Image3
Height = 360
Left = 615
Top = 2085
Visible = 0 'False
Width = 390
End
Begin VB.Image Image2
Height = 450
Left = 390
Top = 1260
Visible = 0 'False
Width = 300
End
Begin VB.Line linLeft
BorderColor = &H00FFFFFF&
X1 = 2490
X2 = 2490
Y1 = 570
Y2 = 1260
End
Begin VB.Line linTop
BorderColor = &H00FFFFFF&
X1 = 2505
X2 = 4110
Y1 = 540
Y2 = 540
End
Begin VB.Line linButton
BorderColor = &H00808080&
X1 = 2490
X2 = 4125
Y1 = 1275
Y2 = 1275
End
Begin VB.Line linRight
BorderColor = &H00808080&
X1 = 4095
X2 = 4095
Y1 = 540
Y2 = 1290
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Label1"
Height = 180
Left = 705
TabIndex = 0
Top = 195
Width = 540
End
Begin VB.Image Image1
Height = 480
Left = 150
Top = 60
Width = 480
End
End
Attribute VB_Name = "HKD"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Public Enum hkState
ncNoCapture
ncDownState
ncUpState
End Enum '枚舉使用的類型
Private Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Dim YN As Boolean
Dim CtrState As hkState
Public Event MouseDown(ByVal Button As Integer, ByVal Shift As Integer)
Public Event MouseUp(ByVal Button As Integer, ByVal Shift As Integer)
Public Event MouseMove(ByVal Button As Integer, ByVal Shift As Integer)
Public Event MouseExit(ByVal Button As Integer, ByVal Shift As Integer)
'缺省屬性值:
Const m_def_CapLeft = 700
Const m_def_CapTop = 200
'屬性變量:
Dim mBackA As OLE_COLOR
Dim mBackB As OLE_COLOR
Dim mBackC As OLE_COLOR
Dim mBsy As Integer
Dim TF As Boolean
Private Sub Image1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call UserControl_MouseMove(Button, Shift, X, Y)
End Sub
Private Sub Label1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call UserControl_MouseMove(Button, Shift, X, Y)
End Sub
Private Sub UserControl_Initialize()
YN = False
TF = False
End Sub
Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
UserControl.BackColor = mBackC
RaiseEvent MouseDown(Button, Shift)
State = ncDownState
YN = False
End If
End Sub
Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim X1 As Single, Y1 As Single
X1 = X - ScaleLeft
Y1 = Y - ScaleTop
If Not TF Then
SetCapture hwnd
TF = True
End If
If (X1 >= 0 And X1 < ScaleWidth And Y1 >= 0 And Y1 < ScaleHeight) Then
If YN Then Exit Sub
If Image2.Picture <> 0 Then Image1.Picture = Image2.Picture
If Button = 1 Then
UserControl.BackColor = mBackC
State = ncDownState
Else
Shape1.BorderStyle = 0
UserControl.BackColor = mBackB
State = ncUpState
End If
RaiseEvent MouseMove(Button, Shift)
YN = True
Else
If Button = 1 Then
If Image2.Picture <> 0 Then Image1.Picture = Image3.Picture
Shape1.BorderStyle = 0
UserControl.BackColor = mBackB 'mBackB
State = ncUpState
Else
UserControl.BackColor = mBackA
Image1.Picture = Image3.Picture
ReleaseCapture
TF = False
RaiseEvent MouseExit(Button, Shift)
State = ncNoCapture
Shape1.BorderStyle = mBsy
End If
YN = False
End If
End Sub
Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim X1 As Single, Y1 As Single
X1 = X - ScaleLeft
Y1 = Y - ScaleTop
TF = False
If (X1 >= 0 And X1 < ScaleWidth And Y1 >= 0 And Y1 < ScaleHeight) Then
If Button = 2 Then Exit Sub
RaiseEvent MouseUp(Button, Shift)
UserControl.BackColor = mBackB
State = ncUpState
SetCapture UserControl.hwnd
Else
UserControl.BackColor = mBackA
ReleaseCapture
State = ncNoCapture
Shape1.BorderStyle = mBsy
YN = False
End If
'YN = False
End Sub
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
State = PropBag.ReadProperty("State", ncNoCapture)
Label1.Caption = PropBag.ReadProperty("Caption", "Label1")
Set Image1.Picture = PropBag.ReadProperty("PictureA", Nothing)
Set Image3.Picture = PropBag.ReadProperty("PictureA", Nothing)
linTop.BorderWidth = PropBag.ReadProperty("Bold", 1)
linLeft.BorderWidth = PropBag.ReadProperty("Bold", 1)
linButton.BorderWidth = PropBag.ReadProperty("Bold", 1)
linRight.BorderWidth = PropBag.ReadProperty("Bold", 1)
Label1.Left = PropBag.ReadProperty("CapLeft", m_def_CapLeft)
Label1.Top = PropBag.ReadProperty("CapTop", m_def_CapTop)
Image1.Left = PropBag.ReadProperty("ImgLeft", 60)
Image1.Top = PropBag.ReadProperty("ImgTop", 60)
Set Image2.Picture = PropBag.ReadProperty("PictrueB", Nothing)
Set Picture = PropBag.ReadProperty("BackPicture", Nothing)
UserControl.BackColor = PropBag.ReadProperty("BackColor", &H8000000F)
UserControl.Enabled = PropBag.ReadProperty("Enabled", True)
Label1.Enabled = PropBag.ReadProperty("Enabled", True)
mBackB = PropBag.ReadProperty("BackB", &H87CDFC)
mBackA = PropBag.ReadProperty("BackColor", &H8000000F)
mBackC = PropBag.ReadProperty("BackC", &HDDDDDD)
Shape1.BorderStyle = PropBag.ReadProperty("BorderStyle", 0)
mBsy = PropBag.ReadProperty("BorderStyle", 0)
Shape1.BorderColor = PropBag.ReadProperty("BackS", &H80000012)
End Sub
Private Sub UserControl_Resize()
State = State
Shape1.Height = Height
Shape1.Width = Width
linTop.X1 = ScaleLeft
linTop.X2 = ScaleLeft + ScaleWidth - ScaleX(1, vbPixels)
linTop.Y1 = ScaleTop
linTop.Y2 = ScaleTop
linLeft.X1 = ScaleLeft
linLeft.X2 = ScaleLeft
linLeft.Y1 = ScaleTop
linLeft.Y2 = ScaleTop + ScaleHeight - ScaleY(1, vbPixels)
linButton.X1 = ScaleLeft
linButton.X2 = ScaleLeft + ScaleWidth - ScaleX(1, vbPixels)
linButton.Y1 = ScaleTop + ScaleHeight - ScaleY(1, vbPixels)
linButton.Y2 = ScaleTop + ScaleHeight - ScaleY(1, vbPixels)
linRight.X1 = ScaleLeft + ScaleWidth - ScaleX(1, vbPixels)
linRight.X2 = ScaleLeft + ScaleWidth - ScaleX(1, vbPixels)
linRight.Y1 = ScaleTop
linRight.Y2 = ScaleTop + ScaleHeight - ScaleY(1, vbPixels)
End Sub
Public Property Let State(Statenew As hkState)
CtrState = Statenew
If Statenew = ncNoCapture Then
linTop.Visible = False
linLeft.Visible = False
linButton.Visible = False
linRight.Visible = False
Else
If Statenew = ncDownState Then
linTop.BorderColor = &H808080
linLeft.BorderColor = &H808080
linButton.BorderColor = &HFFFFFF
linRight.BorderColor = &HFFFFFF
Else
linTop.BorderColor = &HFFFFFF
linLeft.BorderColor = &HFFFFFF
linButton.BorderColor = &H808080
linRight.BorderColor = &H808080
End If
linTop.Visible = True
linLeft.Visible = True
linButton.Visible = True
linRight.Visible = True
End If
PropertyChanged "State"
End Property
Public Property Get State() As hkState
State = CtrState
End Property
Private Sub UserControl_Show()
If Me.BorderStyle <> 0 Then
Shape1.Height = Height
Shape1.Width = Width
End If
End Sub
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
PropBag.WriteProperty "State", CtrState, ncNoCapture
Call PropBag.WriteProperty("Caption", Label1.Caption, "Label1")
Call PropBag.WriteProperty("PictureA", Image1.Picture, Nothing)
Call PropBag.WriteProperty("Bold", linTop.BorderWidth, 1)
Call PropBag.WriteProperty("CapLeft", Label1.Left, m_def_CapLeft)
Call PropBag.WriteProperty("CapTop", Label1.Top, m_def_CapTop)
Call PropBag.WriteProperty("ImgLeft", Image1.Left, 60)
Call PropBag.WriteProperty("ImgTop", Image1.Top, 60)
Call PropBag.WriteProperty("PictrueB", Image2.Picture, Nothing)
Call PropBag.WriteProperty("BackPicture", Picture, Nothing)
Call PropBag.WriteProperty("BackColor", UserControl.BackColor, &H8000000F)
Call PropBag.WriteProperty("Enabled", Label1.Enabled, True)
Call PropBag.WriteProperty("BackB", mBackB, &H87CDFC)
Call PropBag.WriteProperty("BackC", mBackC, &HDDDDDD)
Call PropBag.WriteProperty("BorderStyle", Shape1.BorderStyle, 0)
Call PropBag.WriteProperty("BackS", Shape1.BorderColor, &HFFFFFF)
End Sub
'注意!不要刪除或修改下列被注釋的行!
'MappingInfo=Label1,Label1,-1,Caption
Public Property Get Caption() As String
Caption = Label1.Caption
End Property
Public Property Let Caption(ByVal New_Caption As String)
Label1.Caption() = New_Caption
PropertyChanged "Caption"
End Property
'
Public Property Get PictureA() As Picture
Set PictureA = Image1.Picture
End Property
'
Public Property Set PictureA(ByVal New_Picture As Picture)
Set Image1.Picture = New_Picture
PropertyChanged "PictureA"
End Property
'注意!不要刪除或修改下列被注釋的行!
'MappingInfo=linHilite1,linHilite1,-1,BorderWidth
Public Property Get Bold() As Integer
Bold = linTop.BorderWidth
End Property
Public Property Let Bold(ByVal New_Bold As Integer)
linTop.BorderWidth() = New_Bold
linLeft.BorderWidth() = New_Bold
linButton.BorderWidth() = New_Bold
linRight.BorderWidth() = New_Bold
PropertyChanged "Bold"
End Property
Public Property Get CapLeft() As Variant
CapLeft = Label1.Left
End Property
Public Property Let CapLeft(ByVal New_CapLeft As Variant)
Label1.Left = New_CapLeft
PropertyChanged "CapLeft"
End Property
Public Property Get CapTop() As Variant
CapTop = Label1.Top
End Property
Public Property Let CapTop(ByVal New_CapTop As Variant)
Label1.Top = New_CapTop
PropertyChanged "CapTop"
End Property
'為用戶控件初始化屬性
Private Sub UserControl_InitProperties()
Label1.Left = m_def_CapLeft
Label1.Top = m_def_CapTop
End Sub
Public Property Get ImgLeft() As Variant
ImgLeft = Image1.Left
End Property
Public Property Let ImgLeft(ByVal New_ImgLeft As Variant)
Image1.Left = New_ImgLeft
PropertyChanged "ImgLeft"
End Property
Public Property Get ImgTop() As Variant
ImgTop = Image1.Top
End Property
Public Property Let ImgTop(ByVal New_ImgTop As Variant)
Image1.Top = New_ImgTop
PropertyChanged "ImgTop"
End Property
Public Property Get PictrueB() As Picture
Attribute PictrueB.VB_Description = "返回/設置控件中顯示的圖形。"
Set PictrueB = Image2.Picture
End Property
Public Property Set PictrueB(ByVal New_PictrueB As Picture)
Set Image2.Picture = New_PictrueB
PropertyChanged "PictrueB"
End Property
Public Property Get BackPicture() As Picture
Set BackPicture = UserControl.Picture
End Property
Public Property Set BackPicture(ByVal New_BackPicture As Picture)
Set UserControl.Picture = New_BackPicture
PropertyChanged "BackPicture"
End Property
Public Property Get BackColor() As OLE_COLOR
Attribute BackColor.VB_Description = "返回/設置對象中文本和圖形的背景色。"
BackColor = UserControl.BackColor
End Property
Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
UserControl.BackColor() = New_BackColor
mBackA = New_BackColor
PropertyChanged "BackColor"
End Property
Public Property Get Enabled() As Boolean
Attribute Enabled.VB_Description = "返回/設置一個值,決定一個對象是否響應用戶生成事件。"
Enabled = Label1.Enabled
End Property
Public Property Let Enabled(ByVal New_Enabled As Boolean)
Label1.Enabled() = New_Enabled
UserControl.Enabled = New_Enabled
PropertyChanged "Enabled"
End Property
Public Property Get BackB() As OLE_COLOR
Attribute BackB.VB_Description = "返回/設置對象中文本和圖形的背景色。"
BackB = mBackB
End Property
Public Property Let BackB(ByVal New_BackB As OLE_COLOR)
mBackB = New_BackB
PropertyChanged "BackB"
End Property
Public Property Get BackC() As OLE_COLOR
BackC = mBackC
End Property
Public Property Let BackC(ByVal New_BackC As OLE_COLOR)
mBackC = New_BackC
PropertyChanged "BackC"
End Property
Public Property Get BorderStyle() As Integer
Attribute BorderStyle.VB_Description = "返回/設置對象的邊框樣式。"
BorderStyle = Shape1.BorderStyle
End Property
Public Property Let BorderStyle(ByVal New_BorderStyle As Integer)
Shape1.BorderStyle() = New_BorderStyle
mBsy = New_BorderStyle
PropertyChanged "BorderStyle"
End Property
'
'注意!不要刪除或修改下列被注釋的行!
'MappingInfo=Shape1,Shape1,-1,BorderColor
Public Property Get BackS() As OLE_COLOR
Attribute BackS.VB_Description = "返回/設置對象的邊框顏色。"
BackS = Shape1.BorderColor
End Property
Public Property Let BackS(ByVal New_BackS As OLE_COLOR)
Shape1.BorderColor() = New_BackS
PropertyChanged "BackS"
End Property
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -