?? objdraw.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 = "ObjDraw"
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"
Attribute VB_Ext_KEY = "Member0" ,"RECT"
Option Explicit
'保持屬性值的局部變量(局部復(fù)制)
Private mvarHandls As New ObjHds
Private mvarIsActive As Boolean
Private mvarIsCurrent As Boolean
Private mvarHdCount As Integer
Private mvarnID As Long
Private mvareType As ObjType
Private mvarIsDrawing As Boolean
Private mvarIsSizing As Boolean
Private mvarObjCtl As Object
Private mvarLocked As Boolean
Private mvarIsDraging As Boolean
Private mvarOldX As Single
Private mvarOldY As Single
Private mvarActHdID As Integer
Private mvarColor As Long
Private mvarWidth As Integer
Private mvarStyle As Integer
'自用變量
Private mvarRect As RECTAPI
Private m_Swap As Integer
Private Const NULL_BRUSH = 5
Private Const PS_SOLID = 0
Private Const R2_NOT = 6
Private Const PS_DOT = 2
Private Const PS_DASH = 1
Private Const PS_DASHDOT = 3
Private Const PS_DASHDOTDOT = 4
Private Const SWAP_NONE = &H0
Private Const SWAP_X = &H1
Private Const SWAP_Y = &H2
'Rect Check Function
Private Declare Function IntersectRect Lib "user32" (lpDestRect As RECTAPI, lpSrc1Rect As RECTAPI, lpSrc2Rect As RECTAPI) As Long
'Rect Draw Function
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Long) As Long
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function SetROP2 Lib "gdi32" (ByVal hdc As Long, ByVal nDrawMode As Long) As Long
Private Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal x1 As Long, ByVal y1 As Long, ByVal x2 As Long, ByVal y2 As Long) As Long
'Convert Function
Private Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
'Cursor Fucntion
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
'保持屬性值的局部變量
Private mvarEditFalg As Integer '修改標(biāo)記
Private mvarPrinted As Boolean '局部復(fù)制
Private mvarFix As Boolean
Private mvarDataType As Integer
Private mvarScroll As Boolean
Private mvarSumed As Boolean
Private mvarSumPage As Boolean
Private mvarFormat As String
Private mvarClip As Boolean
Public Property Get Clip() As Boolean
Clip = mvarClip
End Property
Public Property Let Clip(ByVal vData As Boolean)
mvarClip = vData
End Property
'IsFixed
Public Property Let IsFix(vData As Boolean)
mvarFix = vData
If Not mvarFix Then mvarSumed = False: mvarScroll = False: mvarSumPage = False
End Property
Public Property Get IsFix() As Boolean
IsFix = mvarFix
End Property
'DataType
Public Property Let DataType(vData As Integer)
mvarDataType = vData
End Property
Public Property Get DataType() As Integer
DataType = mvarDataType
End Property
'IsScrolled
Public Property Let IsScroll(vData As Boolean)
mvarScroll = vData
If IsScroll Then mvarSumed = False: mvarSumPage = False
End Property
Public Property Get IsScroll() As Boolean
IsScroll = mvarScroll
End Property
'Sumed
Public Property Get Sumed() As Boolean
Sumed = mvarSumed
End Property
Public Property Let Sumed(vData As Boolean)
mvarSumed = vData
If Not mvarSumed Then mvarSumPage = False
End Property
'SumedPage
Public Property Get SumedPage() As Boolean
SumedPage = mvarSumPage
End Property
Public Property Let SumedPage(vData As Boolean)
mvarSumPage = vData
End Property
'Format
Public Property Let Format(vData As String)
mvarFormat = vData
End Property
Public Property Get Format() As String
Format = mvarFormat
End Property
'Printed
Public Property Let Printed(ByVal vData As Boolean)
mvarPrinted = vData
End Property
Public Property Get Printed() As Boolean
Printed = mvarPrinted
End Property
'mvarEditFalg
Public Property Let EditFlag(ByVal vData As Integer)
mvarEditFalg = vData
End Property
Public Property Get EditFlag() As Integer
EditFlag = mvarEditFalg
End Property
'Public Property Let ActTxtKey(ByVal vData As String)
' mvarActTxtKey = vData
'End Property
'
'Public Property Get ActTxtKey() As String
' ActTxtKey = mvarActTxtKey
'End Property
'
'Public Property Let ActText(ByVal vData As Boolean)
' mvarActText = vData
'End Property
'
'Public Property Get ActText() As Boolean
' ActText = mvarActText
'End Property
'ActHdID
Public Property Let ActHdID(ByVal vData As Integer)
mvarActHdID = vData
End Property
Public Property Get ActHdID() As Integer
ActHdID = mvarActHdID
End Property
'BStyle
Public Property Let BStyle(ByVal vData As Integer)
mvarStyle = vData
End Property
Public Property Get BStyle() As Integer
BStyle = mvarStyle
End Property
'BWidth
Public Property Let BWidth(ByVal vData As Integer)
mvarWidth = vData
End Property
Public Property Get BWidth() As Integer
BWidth = mvarWidth
End Property
'FColor
Public Property Let FColor(ByVal vData As Long)
mvarColor = vData
End Property
Public Property Get FColor() As Long
FColor = mvarColor
End Property
'OldY
Public Property Let OldY(ByVal vData As Single)
mvarOldY = vData
End Property
Public Property Get OldY() As Single
OldY = mvarOldY
End Property
'OldX
Public Property Let OldX(ByVal vData As Single)
mvarOldX = vData
End Property
Public Property Get OldX() As Single
OldX = mvarOldX
End Property
'IsDraging
Public Property Let IsDraging(ByVal vData As Boolean)
mvarIsDraging = vData
If mvarIsDraging Then If mvarEditFalg = -1 Then mvarEditFalg = 1
End Property
Public Property Get IsDraging() As Boolean
IsDraging = mvarIsDraging
End Property
'Locked
Public Property Let Locked(ByVal vData As Boolean)
mvarLocked = vData
If mvarLocked Then
SetHdState IIf(mvarIsCurrent, -2, -1)
Else
SetHdState IIf(mvarIsCurrent, 1, 0)
End If
End Property
Public Property Get Locked() As Boolean
Locked = mvarLocked
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
'IsSizing
Public Property Let IsSizing(ByVal vData As Boolean)
mvarIsSizing = vData
If mvarIsSizing Then If mvarEditFalg = -1 Then mvarEditFalg = 1
End Property
Public Property Get IsSizing() As Boolean
IsSizing = mvarIsSizing
End Property
'IsDrawing
Public Property Let IsDrawing(ByVal vData As Boolean)
mvarIsDrawing = vData
'If mvarIsDrawing Then mvarEditFalg = 0
End Property
Public Property Get IsDrawing() As Boolean
IsDrawing = mvarIsDrawing
End Property
'eType
Public Property Let eType(ByVal vData As Integer)
mvareType = vData
End Property
Public Property Get eType() As Integer
eType = mvareType
End Property
'nID
Public Property Let nID(ByVal vData As Long)
mvarnID = vData
End Property
Public Property Get nID() As Long
nID = mvarnID
End Property
'HdCount
Public Property Let HdCount(ByVal vData As Integer)
mvarHdCount = vData
End Property
Public Property Get HdCount() As Integer
Select Case eType
Case 1: mvarHdCount = 2
Case Else: mvarHdCount = 8
End Select
HdCount = mvarHdCount
End Property
'設(shè)置手柄狀態(tài) tmpstate= 0 正常, 1 當(dāng)前, -1 鎖定,-2 當(dāng)前鎖定
Private Sub SetHdState(tmpstate As Integer)
Dim tmphd As ObjHd
Dim tmpcount As Integer
tmpcount = HdCount
For Each tmphd In mvarHandls
If tmphd.HdID < tmpcount Then tmphd.nState = tmpstate
Next
End Sub
'IsCurrent
Public Property Let IsCurrent(ByVal vData As Boolean)
mvarIsCurrent = vData
If Not mvarIsActive And mvarIsCurrent Then IsActive = True
If Not mvarObjCtl Is Nothing Then
If mvarIsCurrent Then
SetHdState IIf(mvarLocked, -2, 1)
mvarHandls.ZOrder
Else
SetHdState IIf(mvarLocked, -1, 0)
End If
End If
End Property
Public Property Get IsCurrent() As Boolean
IsCurrent = mvarIsCurrent
End Property
'IsActive
Public Property Let IsActive(ByVal vData As Boolean)
mvarIsActive = vData
If mvarIsActive And Not mvarObjCtl Is Nothing Then
If mvarLocked Then
SetHdState IIf(mvarIsCurrent, -2, -1)
Else
SetHdState IIf(mvarIsCurrent, 1, 0)
End If
End If
If Not mvarIsActive Then mvarIsCurrent = False
If Not mvarObjCtl Is Nothing Then ShowHd (vData)
If mvareType = mObjText And Not mvarObjCtl Is Nothing Then mvarObjCtl.BorderStyle = IIf(mvarIsActive Or Trim(mvarObjCtl.Caption) = "", 1, 0)
End Property
Public Property Get IsActive() As Boolean
IsActive = mvarIsActive
End Property
'Handls
Public Property Set Handls(ByVal vData As ObjHds)
Set mvarHandls = vData
End Property
Public Property Get Handls() As ObjHds
Set Handls = mvarHandls
End Property
'開始畫
Public Sub OnStartDraw(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim tmpindex As Integer
mvarOldX = X
mvarOldY = Y
IsDrawing = True
With mvarRect
Select Case mvareType
Case mObjSelect:
.Left = X
.Top = Y
.Right = X
.Bottom = Y
Call TwipsToScreen(g_ActFrm.hwnd, mvarRect)
Call DrawDragRect(mvarRect, True)
Case mObjLine:
.Left = X
.Top = Y
tmpindex = g_ActFrm.ObjLine.UBound + 1
Load g_ActFrm.ObjLine(tmpindex)
Set mvarObjCtl = g_ActFrm.ObjLine(tmpindex)
Case mObjText:
tmpindex = g_ActFrm.ObjText.UBound + 1
Load g_ActFrm.ObjText(tmpindex)
g_ActFrm.ObjText(tmpindex).BorderStyle = 1
mvarnID = tmpindex
Set mvarObjCtl = g_ActFrm.ObjText(tmpindex)
Case mObjImg:
tmpindex = g_ActFrm.ObjImg.UBound + 1
Load g_ActFrm.ObjImg(tmpindex)
g_ActFrm.ObjImg(tmpindex).Stretch = True
g_ActFrm.ObjImg(tmpindex).BorderStyle = 1
mvarnID = tmpindex
Set mvarObjCtl = g_ActFrm.ObjImg(tmpindex)
End Select
End With
End Sub
'正在畫
Public Sub OnDrawing(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim tmprect As RECTAPI
Select Case mvareType
Case mObjSelect:
g_ActFrm.PicPage.Cls
Call TwipsToScreen(g_ActFrm.PicPage.hwnd, mvarRect)
Call DrawDragRect(mvarRect, True)
With mvarRect
.Left = mvarOldX
.Top = mvarOldY
.Right = X
.Bottom = Y
End With
Case mObjLine:
g_ActFrm.PicPage.Cls
g_ActFrm.PicPage.Line (mvarOldX, mvarOldY)-(X, Y)
Case mObjText, mObjImg:
With tmprect
.Left = mvarOldX
.Top = mvarOldY
.Right = X
.Bottom = Y
End With
Call SetCtrlToRect(mvarObjCtl, tmprect)
mvarObjCtl.Visible = True
End Select
End Sub
'結(jié)束畫
Public Sub OnEndDraw(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim tmpindex As Long
With mvarRect
.Right = X
.Bottom = Y
Select Case mvareType
Case mObjSelect:
Case mObjLine:
tmpindex = g_ActFrm.ObjLine.UBound
mvarnID = tmpindex
g_ActFrm.PicPage.Cls
mvarObjCtl.x1 = .Left
mvarObjCtl.y1 = .Top
mvarObjCtl.x2 = .Right
mvarObjCtl.y2 = .Bottom
mvarObjCtl.Visible = True
Call LoadHd
Call MoveHd
IsActive = True
Case mObjText, mObjImg:
Call LoadHd
Call MoveHd
IsActive = True
End Select
End With
mvarIsDrawing = False
End Sub
'開始拖動
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -