cdraw.cls

vb开发的连接mysql的工作流设置程序,图形化工作流自定义工具,原先是连接到Domino上的工作流自定义工具,现修改至mysql上,后台管理员设置工作流,前台读取数据库调用.

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CDraw"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Const iSqr = 15
Private m_frmCanvas As Object
Attribute m_frmCanvas.VB_VarHelpID = -1
Public m_L As Single
Public m_T As Single
Private m_W As Long
Private m_H As Long
Private m_LX As Long
Private m_LY As Long
Private IsFocus As Boolean
Private KeyDown As Boolean
Private DragIt As Boolean
Private m_strName As String
Private m_IsDelete As Boolean
Private m_IsHide As Boolean
Private m_DCol As Collection
Private m_SCol As Collection
Private BeingRun As Boolean
Public mpic As Picture
Private mId As String
'调整大小标志：0:不调整；1:左上；2:右下；3:左下；4:右下；
Private ResizeMode As Integer
Implements IDraw

Public Sub Create(DrawObject As Object, ByVal l As Single, ByVal t As Single, _
                    ByVal W As Long, ByVal H As Long)
    Set m_frmCanvas = DrawObject
    m_L = l
    m_T = t
    m_W = W
    m_H = H
    DrawObject.Width = m_W
    DrawObject.Height = m_H
    'Set DrawObject.Picture = mpic
End Sub

Public Property Let Caption(Value As String)
    m_strName = Value
End Property

Public Property Get Caption() As String
    Caption = m_strName
End Property
Public Function InMe(ByVal X As Single, ByVal Y As Single) As Boolean
    InMe = False
    If m_IsDelete Then Exit Function
    If m_IsHide Then Exit Function
    Dim iw As Integer
    iw = 0
    If IsFocus Then
        iw = iSqr
    End If
    If X > m_L - iw And Y > m_T - iw And X < m_L + m_W + iw And Y < m_T + m_H + iw Then
        InMe = True
    End If
End Function

Public Sub GotFocus()
    m_frmCanvas.Line (m_L - iSqr, m_T - iSqr)-(m_L + m_W + iSqr, m_T + m_H + iSqr), , B
End Sub

Public Sub LostFocus()
    m_frmCanvas.Line (m_L - iSqr, m_T - iSqr)-(m_L + m_W + iSqr, m_T + m_H + iSqr), m_frmCanvas.BackColor, B
End Sub

Public Sub Paint()
'    pic.Draw
    If m_IsDelete Or m_IsHide Then Exit Sub
    Dim c As IDraw
    m_frmCanvas.Line (m_L, m_T)-(m_L + m_W, m_T + m_H), m_frmCanvas.BackColor, BF
    m_frmCanvas.Line (m_L, m_T)-(m_L, m_T + m_H), RGB(255, 255, 255)
    m_frmCanvas.Line (m_L, m_T)-(m_L + m_W, m_T), RGB(255, 255, 255)
    m_frmCanvas.Line (m_L + m_W, m_T)-(m_L + m_W, m_T + m_H)
    m_frmCanvas.Line (m_L, m_T + m_H)-(m_L + m_W, m_T + m_H)
    If IsFocus Then
        GotFocus
    End If
    m_frmCanvas.PSet (m_L + 10, m_T + m_W + 30), m_frmCanvas.BackColor
    Dim strName As String
    If Len(m_strName) > 4 Then
        strName = Left(m_strName, 4) & ".."
    Else
        strName = m_strName
    End If
    m_frmCanvas.Print strName

    'debug.Print Me.m_L, Me.m_T, m_W, m_H
    'RaiseEvent Action(Me)
End Sub
Public Sub Paint2()
    If mpic Is Nothing Then Exit Sub
    If m_IsDelete Then Exit Sub
    If m_frmCanvas Is Nothing Then Exit Sub
    'm_frmCanvas.AutoRedraw = False
    Dim b As Boolean
    'b = m_frmCanvas.AutoRedraw
    'If b = True Then m_frmCanvas.AutoRedraw = False
    m_frmCanvas.PaintPicture mpic, m_L, m_T, , , , , , , vbSrcCopy
    m_frmCanvas.PSet (m_L + 100, m_T + 100), m_frmCanvas.BackColor
    Dim strName As String
    If Len(m_strName) > 4 Then
        strName = Left(m_strName, 3) & ".."
    Else
        strName = m_strName
    End If
    m_frmCanvas.Print strName
    'm_frmCanvas.AutoRedraw = True
End Sub

Private Sub Class_Initialize()
    Set m_SCol = New Collection
    Set m_DCol = New Collection
End Sub

Private Sub Class_Terminate()
    Set m_SCol = Nothing
    Set m_DCol = Nothing
End Sub

Private Sub IDraw_AddR(Source As IDraw, Optional ByVal sType As Integer)
    If sType = 1 Then
        m_DCol.Add Source
    Else
        m_SCol.Add Source
    End If
End Sub

Private Property Let IDraw_AutoAgents(RHS() As String)

End Property

Private Function IDraw_BeingRun() As Boolean
    IDraw_BeingRun = BeingRun
    BeingRun = False
End Function

Private Function IDraw_CanMove() As Boolean
    IDraw_CanMove = True
End Function

Private Function IDraw_Caption() As String
    IDraw_Caption = ""
End Function

Private Function IDraw_CountR() As Integer
    IDraw_CountR = 0
End Function

Private Sub IDraw_Create(frm As Object)
    Create frm, 200, 200, 55 * Screen.TwipsPerPixelX, 40 * Screen.TwipsPerPixelY
End Sub

Private Sub IDraw_Delete()
    m_IsDelete = True
    Set mpic = Nothing
    Dim a As IDraw
    For Each a In m_DCol
        a.Hide
        a.Delete
    Next
    For Each a In m_SCol
        a.Hide
        a.Delete
    Next
    IDraw_Hide
End Sub

Private Function IDraw_Height() As Long
    IDraw_Height = m_H
End Function

Private Sub IDraw_Hide()
    m_IsHide = True
End Sub

Private Property Let IDraw_id(ByVal RHS As String)
    mId = RHS
End Property

Private Property Get IDraw_id() As String
    IDraw_id = mId
End Property

Private Function IDraw_InMe(ByVal X As Single, ByVal Y As Single) As Boolean
    IDraw_InMe = InMe(X, Y)
End Function

Private Function IDraw_IsDelete() As Boolean
    IDraw_IsDelete = m_IsDelete
End Function

Private Function IDraw_isHide() As Boolean
    IDraw_isHide = m_IsHide
End Function

Private Function IDraw_Left() As Single
    IDraw_Left = m_L
End Function

Private Sub IDraw_LostFocus()
    IsFocus = False
End Sub

Private Function IDraw_ModeName() As Integer
    IDraw_ModeName = 2
End Function

Private Sub IDraw_MoveTo(ByVal X As Single, ByVal Y As Single)
    m_L = X
    m_T = Y
End Sub

Private Function IDraw_NextNodes() As Collection
    Dim col As Collection
    Dim ia As IDraw
    Set col = New Collection
    For Each ia In m_DCol
        If Not (ia.IsDelete Or ia.isHide) Then
            col.Add ia
        End If
    Next ia
    Set IDraw_NextNodes = col
End Function

Private Sub IDraw_Paint()
'    Paint2
End Sub

Private Function IDraw_PrevNodes() As Collection
    Dim col As Collection
    Dim ia As IDraw
    Set col = New Collection
    For Each ia In m_SCol
        If Not (ia.IsDelete Or ia.isHide) Then
            col.Add ia
        End If
    Next ia
    Set IDraw_PrevNodes = col
End Function

Private Function IDraw_Properties() As Object
    Set IDraw_Properties = Nothing
End Function

Private Sub IDraw_RunClear()
    BeingRun = False
End Sub

Private Sub IDraw_SetFocus()
    IsFocus = False
End Sub

Private Sub IDraw_Show()
    m_IsHide = False
End Sub

Private Sub IDraw_ShowProperties()
    'frmproperties.Display
End Sub

Private Sub IDraw_TestRun()
    Dim ia As IDraw, s As String
    s = MErrors.NextNodeNotFind
    For Each ia In m_DCol
        If Not (ia.IsDelete Or ia.isHide) Then
            s = ""
            Exit For
        End If
    Next ia
    If s <> "" Then
        MErrors.Add Me, Me.Caption, s
    End If
    s = MErrors.PrevNodeNotFind
    For Each ia In m_SCol
        If Not (ia.IsDelete Or ia.isHide) Then
            s = ""
            Exit For
        End If
    Next ia
    If s <> "" Then
        MErrors.Add Me, Me.Caption, s
    End If
End Sub

Private Function IDraw_Top() As Single
    IDraw_Top = m_T
End Function

Private Sub IDraw_UnDel()
    m_IsDelete = False
End Sub

Private Function IDraw_Width() As Long
    IDraw_Width = m_W
End Function