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

'保持属性值的局部变量(局部复制)
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 '修改标记
Private mvarPrinted As Boolean '局部复制

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

'设置手柄状态 tmpstate= 0 正常, 1 当前, -1 锁定,-2 当前锁定
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

'结束画
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

'开始拖动