?? objhd.cls
字號:
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "ObjHd"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Option Explicit
'保持屬性值的局部變量(局部復制)
Private mvarHdID As Integer
Private mvarObjCtl As Object
Private mvarnState As Integer
'Old Color
'Private Const DefaultColor = &H800000
'Private Const LockedColor = vbRed
'Private Const CurrentColor = vbBlue
'Private Const CurLockColor = LockedColor + CurrentColor
'nState
Public Property Let nState(ByVal vData As Integer)
mvarnState = vData
If Not mvarObjCtl Is Nothing Then
With mvarObjCtl
Select Case mvarnState
Case -2: .Picture = g_ActFrm.ImgCurLock.Picture
Case -1: .Picture = g_ActFrm.ImgLock.Picture
Case 1: .Picture = g_ActFrm.ImgCur.Picture
Case Else: .Picture = g_ActFrm.ImgAct.Picture
' Case -2: .BackColor = CurLockColor
' Case -1: .BackColor = LockedColor
' Case 1: .BackColor = CurrentColor
' Case Else: .BackColor = DefaultColor
End Select
.MousePointer = IIf(mvarnState < 0, vbDefault, GetPointType(Val(.Tag)))
End With
End If
End Property
Public Property Get nState() As Integer
nState = mvarnState
End Property
'HdID
Public Property Let HdID(ByVal vData As Integer)
mvarHdID = vData
End Property
Public Property Get HdID() As Integer
HdID = mvarHdID
End Property
'ObjCtl
Public Property Set ObjCtl(ByVal vData As Object)
Set mvarObjCtl = vData
End Property
Public Property Get ObjCtl() As Object
Set ObjCtl = mvarObjCtl
End Property
'Move
Public Sub Move(Left As Single, Top As Single)
mvarObjCtl.Move Left, Top
End Sub
'OnMouseDown
Public Sub OnMouseDown(obj As ObjDraw, Button As Integer, Shift As Integer, X As Single, Y As Single)
Call obj.OnStartSize(mvarHdID, Button, Shift, X, Y)
End Sub
'OnMouseMove
Public Sub OnMouseMove(obj As ObjDraw, Button As Integer, Shift As Integer, X As Single, Y As Single)
Call obj.OnSizing(Button, Shift, X, Y)
End Sub
'OnMouseUp
Public Sub OnMouseUp(obj As ObjDraw, Button As Integer, Shift As Integer, X As Single, Y As Single)
Call obj.OnEndSize(Button, Shift, X, Y)
End Sub
'GetPointType
Private Function GetPointType(tmpidx As Integer) As Integer
Select Case tmpidx
'Top Left
Case 1: GetPointType = vbSizeNWSE
'Top center
Case 2: GetPointType = vbSizeNS
'Top right
Case 3: GetPointType = vbSizeNESW
'Center right
Case 4: GetPointType = vbSizeWE
'Bottom Right
Case 5: GetPointType = vbSizeNWSE
'Bottom center
Case 6: GetPointType = vbSizeNS
'Bottom left
Case 7: GetPointType = vbSizeNESW
'Center left
Case 8: GetPointType = vbSizeWE
'Default
Case Else: GetPointType = vbDefault
End Select
End Function
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -