objdraw.ctl

一款开源的完整矢量绘图控件源码,支持直线、弧线、矩形、圆角矩形、椭圆、多边形、星形、文本和图片等的绘制

            DrawRoundRectangle ObjList(ObjIndex).mLeft, ObjList(ObjIndex).mTop, _
            (tx - ObjList(ObjIndex).mLeft), (ty - ObjList(ObjIndex).mTop), ObjList(ObjIndex).mPointQty, ObjList(ObjIndex).mAngle
        
        Case mEllipse
        tx = X
        ty = Y
            If Shift = 2 Then
            tAspect = 1
            ty = tx - ObjList(ObjIndex).mLeft + ObjList(ObjIndex).mTop
            ObjList(ObjIndex).mHeight = ty - ObjList(ObjIndex).mTop
            End If
            DrawControl.ForeColor = vbYellow
            DrawEllipse ObjList(ObjIndex).mLeft, ObjList(ObjIndex).mTop, _
            (tx - ObjList(ObjIndex).mLeft), (ty - ObjList(ObjIndex).mTop), ObjList(ObjIndex).mAngle ', False
        Case mText
        tx = X
        ty = Y
            If Shift = 2 Then
            tAspect = 1
            ty = tx - ObjList(ObjIndex).mLeft + ObjList(ObjIndex).mTop
            ObjList(ObjIndex).mHeight = ty - ObjList(ObjIndex).mTop
            End If
            DrawControl.ForeColor = vbYellow
            DrawRectangle ObjList(ObjIndex).mLeft, ObjList(ObjIndex).mTop, _
            (tx - ObjList(ObjIndex).mLeft), (ty - ObjList(ObjIndex).mTop), ObjList(ObjIndex).mAngle
        Case mImage
        tx = X
        ty = Y
            If Shift = 2 Then
            tAspect = 1
            ty = tx - ObjList(ObjIndex).mLeft + ObjList(ObjIndex).mTop
            tRatio = ObjList(ObjIndex).mPicture.Height / ObjList(ObjIndex).mPicture.Width
            ObjList(ObjIndex).mWidth = tx - ObjList(ObjIndex).mLeft
            ObjList(ObjIndex).mHeight = tRatio * ObjList(ObjIndex).mWidth
            Else
            ObjList(ObjIndex).mWidth = tx - ObjList(ObjIndex).mLeft
            ObjList(ObjIndex).mHeight = ty - ObjList(ObjIndex).mTop
            End If
            DrawControl.ForeColor = vbYellow
            DrawRectangle ObjList(ObjIndex).mLeft, ObjList(ObjIndex).mTop, _
            (tx - ObjList(ObjIndex).mLeft), (ty - ObjList(ObjIndex).mTop), ObjList(ObjIndex).mAngle
        Case mPolygon
        tx = X
        ty = Y
            If Shift = 2 Then
            tAspect = 1
            ty = tx - ObjList(ObjIndex).mLeft + ObjList(ObjIndex).mTop
            ObjList(ObjIndex).mHeight = ty - ObjList(ObjIndex).mTop
            End If
            DrawControl.ForeColor = vbYellow
            DrawPolygon ObjList(ObjIndex).mPointQty, ObjList(ObjIndex).mLeft, ObjList(ObjIndex).mTop, _
            (tx - ObjList(ObjIndex).mLeft), (ty - ObjList(ObjIndex).mTop), ObjList(ObjIndex).mAngle
    
        Case mStar
        tx = X
        ty = Y
            If Shift = 2 Then
            tAspect = 1
            ty = tx - ObjList(ObjIndex).mLeft + ObjList(ObjIndex).mTop
            ObjList(ObjIndex).mHeight = ty - ObjList(ObjIndex).mTop
            End If
            DrawControl.ForeColor = vbYellow
            DrawStar ObjList(ObjIndex).mPointQty, ObjList(ObjIndex).mLeft, ObjList(ObjIndex).mTop, _
            (tx - ObjList(ObjIndex).mLeft), (ty - ObjList(ObjIndex).mTop), ObjList(ObjIndex).mAngle
    End Select
    
    DrawControl.DrawMode = 13
    
    RaiseEvent ObjectResize(ObjList(ObjIndex).mObjectType, ObjIndex, ObjList(ObjIndex).mLeft, _
    ObjList(ObjIndex).mTop, tx - ObjList(ObjIndex).mLeft, ty - ObjList(ObjIndex).mTop, tAspect)
    
    DrawControl.DrawStyle = 0
    ElseIf Button = 1 And isDown = False Then 'resize object
        If isResize = True Then
            tRatio = ObjList(ObjIndex).mHeight / ObjList(ObjIndex).mWidth
            tx = X / mZF
            ty = Y / mZF
            Select Case toSize
                Case 0
                Tmp = ObjList(ObjIndex).mTop + ObjList(ObjIndex).mHeight
                ObjList(ObjIndex).mTop = ty
                ObjList(ObjIndex).mHeight = Tmp - ty
                Tmp = ObjList(ObjIndex).mLeft + ObjList(ObjIndex).mWidth
                ObjList(ObjIndex).mLeft = tx
                ObjList(ObjIndex).mWidth = Tmp - tx
                    If ObjList(ObjIndex).mObjectType = mArc Then
                    Tmp = ObjList(ObjIndex).mPosY1 - ty
                    EditArc ObjIndex, toHeightN, Tmp
                    Tmp = ObjList(ObjIndex).mPosX0 - tx
                    EditArc ObjIndex, toWidthN, Tmp
                    End If
                Case 1
                Tmp = ObjList(ObjIndex).mTop + ObjList(ObjIndex).mHeight
                ObjList(ObjIndex).mTop = ty
                ObjList(ObjIndex).mHeight = Tmp - ty
                    If ObjList(ObjIndex).mObjectType = mArc Then
                    Tmp = ObjList(ObjIndex).mPosY1 - ty
                    EditArc ObjIndex, toHeightN, Tmp
                    End If
                Case 2
                Tmp = ObjList(ObjIndex).mTop + ObjList(ObjIndex).mHeight
                ObjList(ObjIndex).mTop = ty
                ObjList(ObjIndex).mHeight = Tmp - ty
                ObjList(ObjIndex).mWidth = tx - ObjList(ObjIndex).mLeft
                    If ObjList(ObjIndex).mObjectType = mArc Then
                    Tmp = ObjList(ObjIndex).mPosY1 - ty
                    EditArc ObjIndex, toHeightN, Tmp
                    Tmp = tx - ObjList(ObjIndex).mPosX3
                    EditArc ObjIndex, toWidthP, Tmp
                    End If
                Case 3
                Tmp = ObjList(ObjIndex).mLeft + ObjList(ObjIndex).mWidth
                ObjList(ObjIndex).mLeft = tx
                ObjList(ObjIndex).mWidth = Tmp - tx
                    If ObjList(ObjIndex).mObjectType = mArc Then
                    Tmp = ObjList(ObjIndex).mPosX0 - tx
                    EditArc ObjIndex, toWidthN, Tmp
                    End If
                Case 4
                ObjList(ObjIndex).mWidth = tx - ObjList(ObjIndex).mLeft
                    If ObjList(ObjIndex).mObjectType = mArc Then
                    Tmp = tx - ObjList(ObjIndex).mPosX3
                    EditArc ObjIndex, toWidthP, Tmp
                    End If
                Case 5
                Tmp = ObjList(ObjIndex).mLeft + ObjList(ObjIndex).mWidth
                ObjList(ObjIndex).mLeft = tx
                ObjList(ObjIndex).mWidth = Tmp - tx
                ObjList(ObjIndex).mHeight = ty - ObjList(ObjIndex).mTop
                    If ObjList(ObjIndex).mObjectType = mArc Then
                    Tmp = ObjList(ObjIndex).mPosX0 - tx
                    EditArc ObjIndex, toWidthN, Tmp
                    Tmp = ty - ObjList(ObjIndex).mPosY0
                    EditArc ObjIndex, toHeightP, Tmp
                    End If
                Case 6
                ObjList(ObjIndex).mHeight = ty - ObjList(ObjIndex).mTop
                    If ObjList(ObjIndex).mObjectType = mArc Then
                    Tmp = ty - ObjList(ObjIndex).mPosY0
                    EditArc ObjIndex, toHeightP, Tmp
                    End If
                Case 7
                ObjList(ObjIndex).mWidth = tx - ObjList(ObjIndex).mLeft
                ObjList(ObjIndex).mHeight = ty - ObjList(ObjIndex).mTop
                    If ObjList(ObjIndex).mObjectType = mArc Then
                    Tmp = tx - ObjList(ObjIndex).mPosX3
                    EditArc ObjIndex, toWidthP, Tmp
                    Tmp = ty - ObjList(ObjIndex).mPosY0
                    EditArc ObjIndex, toHeightP, Tmp
                    End If
            End Select
                If Shift = 2 Then ObjList(ObjIndex).mHeight = tRatio * ObjList(ObjIndex).mWidth
            ReDraw
            Exit Sub
        ElseIf ObjIndex = -1 Then ' draw dot rect for mouse selection
        ReDraw
        DrawControl.DrawStyle = 2
        DrawControl.DrawMode = 7
        DrawControl.Line (DownX, DownY)-(X, Y), &H55F5F, B
        DrawControl.DrawStyle = 0
        DrawControl.DrawMode = 13
        MouseSel = True
        End If
    
        If onObject = True Then 'move object
        ReDraw
        DrawControl.MousePointer = 15
        DrawControl.DrawStyle = 4
        DrawControl.DrawMode = 7
        DrawControl.ForeColor = &H808080
        tx = (X - LeftSel) * mZF
        ty = (Y - TopSel) * mZF
        Xmove = 0
        Ymove = 0
        tGr = ObjList(ObjIndex).mGroupMember
        
            If QtySel > 0 And tGr = 0 Then
            Xmove = tx - ObjList(ObjIndex).mLeft
            Ymove = ty - ObjList(ObjIndex).mTop
            For n = 0 To QtySel - 1
            tIndex = ListSel(n)
            tX2 = ObjList(tIndex).mLeft + Xmove
            tY2 = ObjList(tIndex).mTop + Ymove
            Select Case ObjList(tIndex).mObjectType
                Case mline
                DrawControl.Line (tX2, tY2)-(tX2 + ObjList(tIndex).mWidth * mZF, tY2 + ObjList(tIndex).mHeight * mZF), &H808080
                
                Case mArc
                DrawArc tIndex, tX2, tY2, ObjList(tIndex).mWidth, ObjList(tIndex).mHeight, _
                (ObjList(tIndex).mPosX0 + Xmove) * mZF, (ObjList(tIndex).mPosY0 + Ymove) * mZF, _
                (ObjList(tIndex).mPosX1 + Xmove) * mZF, (ObjList(tIndex).mPosY1 + Ymove) * mZF, _
                (ObjList(tIndex).mPosX2 + Xmove) * mZF, (ObjList(tIndex).mPosY2 + Ymove) * mZF, _
                (ObjList(tIndex).mPosX3 + Xmove) * mZF, (ObjList(tIndex).mPosY3 + Ymove) * mZF
                 
                Case mRectangle
                DrawRectangle tX2, tY2, ObjList(tIndex).mWidth * mZF, ObjList(tIndex).mHeight * mZF, ObjList(tIndex).mAngle
                
                Case mRoundRectangle
                DrawRoundRectangle tX2, tY2, ObjList(tIndex).mWidth * mZF, ObjList(tIndex).mHeight * mZF, ObjList(tIndex).mPointQty, ObjList(tIndex).mAngle
                
                Case mEllipse
                DrawEllipse tX2, tY2, ObjList(tIndex).mWidth * mZF, ObjList(tIndex).mHeight * mZF, ObjList(tIndex).mAngle ', False
                
                Case mText
                DrawRectangle tX2, tY2, ObjList(tIndex).mWidth * mZF, ObjList(tIndex).mHeight * mZF, ObjList(tIndex).mAngle
    
                Case mImage
                DrawRectangle tX2, tY2, ObjList(tIndex).mWidth * mZF, ObjList(tIndex).mHeight * mZF, ObjList(tIndex).mAngle
             
                Case mPolygon
                DrawPolygon ObjList(tIndex).mPointQty, tX2, tY2, ObjList(tIndex).mWidth * mZF, ObjList(tIndex).mHeight * mZF, ObjList(tIndex).mAngle
           
                Case mStar
                DrawStar ObjList(tIndex).mPointQty, tX2, tY2, ObjList(tIndex).mWidth * mZF, ObjList(tIndex).mHeight * mZF, ObjList(tIndex).mAngle
            
            End Select
            Next n
            
            ElseIf tGr > 0 Then
            Xmove = tx - ObjList(ObjIndex).mLeft
            Ymove = ty - ObjList(ObjIndex).mTop
            For n = 0 To ObjQty - 1
                If ObjList(n).mGroupMember = tGr Then
                tX2 = ObjList(n).mLeft + Xmove
                tY2 = ObjList(n).mTop + Ymove
                Select Case ObjList(n).mObjectType
                    Case mline
                    DrawControl.Line (tX2, tY2)-(tX2 + ObjList(n).mWidth * mZF, tY2 + ObjList(n).mHeight * mZF), &H808080
                    
                    Case mArc
                    DrawArc n, tX2, tY2, ObjList(n).mWidth, ObjList(n).mHeight, _
                    (ObjList(n).mPosX0 + Xmove) * mZF, (ObjList(n).mPosY0 + Ymove) * mZF, _
                    (ObjList(n).mPosX1 + Xmove) * mZF, (ObjList(n).mPosY1 + Ymove) * mZF, _
                    (ObjList(n).mPosX2 + Xmove) * mZF, (ObjList(n).mPosY2 + Ymove) * mZF, _
                    (ObjList(n).mPosX3 + Xmove) * mZF, (ObjList(n).mPosY3 + Ymove) * mZF
                     
                    Case mRectangle
                    DrawRectangle tX2, tY2, ObjList(n).mWidth * mZF, ObjList(n).mHeight * mZF, ObjList(n).mAngle
                    
                    Case mRoundRectangle
                    DrawRoundRectangle tX2, tY2, ObjList(n).mWidth * mZF, ObjList(n).mHeight * mZF, ObjList(n).mPointQty, ObjList(n).mAngle
                    
                    Case mEllipse
                    DrawEllipse tX2, tY2, ObjList(n).mWidth * mZF, ObjList(n).mHeight * mZF, ObjList(n).mAngle ', False
                    
                    Case mText
                    DrawRectangle tX2, tY2, ObjList(n).mWidth * mZF, ObjList(n).mHeight * mZF, ObjList(n).mAngle
        
                    Case mImage
                    DrawControl.Line (tX2, tY2)-(tX2 + ObjList(n).mWidth * mZF, tY2 + ObjList(n).mHeight * mZF), &H808080, B
                    
                    Case mPolygon
                    DrawPolygon ObjList(n).mPointQty, tX2, tY2, ObjList(n).mWidth * mZF, ObjList(n).mHeight * mZF, ObjList(n).mAngle
               
                    Case mStar
                    DrawStar ObjList(n).mPointQty, tX2, tY2, ObjList(n).mWidth * mZF, ObjList(n).mHeight * mZF, ObjList(n).mAngle
                
                End Select
                End If
            Next n
            End If
        DrawControl.DrawMode = 13
        DrawControl.DrawStyle = 0
        isMove = True
            If NewText = False Then
            RaiseEvent ObjSelected(ObjList(ObjIndex).mObjectType, ObjIndex, tx, ty, ObjList(ObjIndex).mWidth, _
            ObjList(ObjIndex).mHeight, ObjList(ObjIndex).mAngle, ObjList(ObjIndex).mFillColor, ObjList(ObjIndex).mFillStyle, _
            ObjList(ObjIndex).mBorderColor, ObjList(ObjIndex).mBorderWidth, ObjList(ObjIndex).mAspect, _
            ObjList(ObjIndex).mFontName, ObjList(ObjIndex).mFontSize, ObjList(ObjIndex).mFontBold, _
            ObjList(ObjIndex).mFontItalic, ObjList(ObjIndex).mFontUnderline, ObjList(ObjIndex).mFontStrikethru, _
            ObjList(ObjIndex).mText, ObjList(ObjIndex).mTextAlign, ObjList(ObjIndex).mPointQty)
            End If
        End If
    End If
    RaiseEvent MouseMove(Button, Shift, X / mZF, Y / mZF)
End Sub

Private Sub DrawControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    On Error Resume Next
    Dim tBorderColor As Long
    Dim tWidth As Integer
    Dim tIndex As Long
    Dim n As Long
    Dim tC As myCoorType
    Dim tGr As Integer
    
    DrawControl.MousePointer = 0
    If NextLine = True Then
        If Button = 2 Then
        NextLine = False
        NewObj = False
        ObjQty = ObjQty - 1
        ReDim Preserve ObjList(ObjQty)
        ReDraw
        DrawControl_MouseDown 1, 0, -5, -5
        End If
    End If
    
    If isResize = True Then
    Add2UndoBuffer
    isResize = False
    ReDraw
    End If
    
    If NewObj = True Then
    NewObj = False
    isDown = False
        If ObjList(ObjIndex).mObjectType <> mline Then
        With ObjList(ObjIndex)
        .mLeft = .mLeft / mZF
        .mTop = .mTop / mZF
        .mHeight = (Y / mZF - .mTop)
        .mWidth = (X / mZF - .mLeft)
            If Shift = 2 Then .mAspect = 1 Else .mAspect = 0
        tBorderColor = .mBorderColor
        tWidth = .mBorderWidth
        If ObjList(ObjIndex).mObjectType = mArc Then InitArc ObjIndex
        ReDraw
        End With
        ElseIf ObjList(ObjIndex).mObjectType = mline Then
        ObjList(ObjIndex).mHeight = (Y - ObjList(ObjIndex).mTop) / mZF
        ObjList(ObjIndex).mWidth = (X - ObjList(ObjIndex).mLeft) / mZF
        tBorderColor = ObjList(ObjIndex).mBorderColor
        tWidth = ObjList(ObjIndex).mBorderWidth
        AddObject mline, Y, X, , , , , , tBorderColor, tWidth
        NewObj = True
        NextLine = True
        DrawControl.MousePointer = 99
        Set DrawControl.MouseIcon = cLine.Picture
        End If
    
        If NewText = True And myText.Visible = False Then
            With ObjList(ObjIndex)
            DrawControl.MousePointer = 3
            myText.Left = .mLeft
            myText.Top = .mTop
            myText.Font = .mFontName
            myText.FontSize = .mFontSize * mZF
            myText.FontBold = .mFontBold
            myText.FontItalic = .mFontItalic
            myText.FontUnderline = .mFontUnderline
            myText.FontStrikethru = .mFontStrikethru