objdraw.ctl

来自「一款开源的完整矢量绘图控件源码,支持直线、弧线、矩形、圆角矩形、椭圆、多边形、星」· CTL 代码 · 共 1,707 行 · 第 1/5 页

            myText.Alignment = .mTextAlign
            DrawControl.FontName = .mFontName
            DrawControl.FontSize = .mFontSize
            DrawControl.FontBold = .mFontBold
            DrawControl.FontItalic = .mFontItalic
            DrawControl.FontUnderline = .mFontUnderline
            DrawControl.FontStrikethru = .mFontStrikethru
                If Len(.mText) = 0 Then
                myText.Text = mDefaultText
                Else
                myText.Text = .mText
                End If
                If .mWidth < DrawControl.TextWidth(myText.Text) Then
                myText.Width = DrawControl.TextWidth(myText.Text)
                .mWidth = myText.Width
                Else
                myText.Width = .mWidth
                End If
                If .mHeight < DrawControl.TextHeight(myText.Text) Then
                myText.Height = DrawControl.TextHeight(myText.Text)
                .mHeight = myText.Height
                Else
                myText.Height = .mHeight
                End If
            myText.Visible = True
            myText.SelStart = 0
            myText.SelLength = Len(myText.Text)
            myText.SetFocus
            End With
        End If
    Add2UndoBuffer
    RaiseEvent NewDrawingEnd
    ElseIf Button = 1 And onObject = True And isMove = True Then
    isMove = False
    tGr = ObjList(ObjIndex).mGroupMember
        If QtySel > 0 And tGr = 0 Then
        For n = 0 To QtySel - 1
        tIndex = ListSel(n)
        With ObjList(tIndex)
            .mLeft = (.mLeft + Xmove) / mZF
            .mTop = (.mTop + Ymove) / mZF
            If .mObjectType = mArc Then
            .mPosX0 = (.mPosX0 + Xmove)
            .mPosY0 = (.mPosY0 + Ymove)
            .mPosX1 = (.mPosX1 + Xmove)
            .mPosY1 = (.mPosY1 + Ymove)
            .mPosX2 = (.mPosX2 + Xmove)
            .mPosY2 = (.mPosY2 + Ymove)
            .mPosX3 = (.mPosX3 + Xmove)
            .mPosY3 = (.mPosY3 + Ymove)
            End If
        End With
        Next n
        ElseIf tGr > 0 Then
        For n = 0 To ObjQty - 1
        With ObjList(n)
            If .mGroupMember = tGr Then
            .mLeft = (.mLeft + Xmove) / mZF
            .mTop = (.mTop + Ymove) / mZF
            End If
        End With
        Next n
        End If
    Add2UndoBuffer
    ReDraw
    ElseIf Button = 1 And MouseSel = True Then
        For n = ObjQty - 1 To 0 Step -1
        tC = GetSelPosition(ObjList(n).mLeft, ObjList(n).mTop, ObjList(n).mWidth, ObjList(n).mHeight, ObjList(n).mAngle)
        With tC
        If .posX1 > DownX And .posY1 > DownY And .posX3 < X And .posY3 < Y Or _
        .posX1 > X And .posY1 > Y And .posX3 < DownX And .posY3 < DownY Or _
        .posX1 > X And .posY1 > DownY And .posX3 < DownX And .posY3 < Y Or _
        .posX1 > DownX And .posY1 > Y And .posX3 < X And .posY3 < DownY Then
            If QtySel = 0 Then ObjIndex = n
            Add2Selection n
            End If
        End With
        Next n
        ShowSelection
    MouseSel = False
    ReDraw
    End If
    RaiseEvent MouseUp(Button, Shift, X, Y)
End Sub

Private Sub ReDraw(Optional ShowSel As Boolean = True)
    On Error Resume Next
    Dim tRatio As Double
    Dim n As Long
    
    DrawControl.Cls
    DrawControl.DrawMode = 13
    
    If ObjQty > 0 Then
        For n = 0 To ObjQty - 1
        With ObjList(n)
        If .mDeleted = False Then
    
            DrawControl.FillStyle = .mFillStyle
        
            If .mBorderWidth <= 0 Then
            DrawControl.DrawStyle = 5
            Else
            DrawControl.DrawStyle = 0
            End If
        
            Select Case .mObjectType
                Case mline
                If DrawControl.DrawWidth < 1 Then DrawControl.DrawWidth = 1
                DrawControl.DrawWidth = .mBorderWidth * mZF
                DrawControl.ForeColor = .mBorderColor
                DrawControl.Line (.mLeft * mZF, .mTop * mZF)-((.mLeft * mZF) + (.mWidth * mZF), (.mTop * mZF + .mHeight * mZF)), Abs(.mBorderColor)
                
                Case mArc
                DrawControl.FillColor = .mFillColor
                DrawControl.DrawWidth = .mBorderWidth * mZF
                DrawControl.ForeColor = .mBorderColor
                DrawArc n, .mLeft * mZF, .mTop * mZF, .mWidth * mZF, .mHeight * mZF, .mPosX0 * mZF, .mPosY0 * mZF, _
                .mPosX1 * mZF, .mPosY1 * mZF, .mPosX2 * mZF, .mPosY2 * mZF, .mPosX3 * mZF, .mPosY3 * mZF
    
                Case mRectangle
                If .mAspect = 1 Then
                .mHeight = .mWidth
                End If
                DrawControl.DrawWidth = .mBorderWidth * mZF
                DrawControl.FillColor = .mFillColor
                DrawControl.ForeColor = .mBorderColor
                DrawRectangle .mLeft * mZF, .mTop * mZF, .mWidth * mZF, .mHeight * mZF, .mAngle
                
                Case mRoundRectangle
                If .mAspect = 1 Then
                .mHeight = .mWidth
                End If
                DrawControl.DrawWidth = .mBorderWidth * mZF
                DrawControl.FillColor = .mFillColor
                DrawControl.ForeColor = .mBorderColor
                DrawRoundRectangle .mLeft * mZF, .mTop * mZF, .mWidth * mZF, .mHeight * mZF, .mPointQty, .mAngle
                
                Case mEllipse
                If .mAspect = 1 Then
                .mHeight = .mWidth
                End If
                DrawControl.FillColor = .mFillColor
                DrawControl.DrawWidth = .mBorderWidth * mZF
                DrawControl.ForeColor = .mBorderColor
                DrawEllipse .mLeft * mZF, .mTop * mZF, .mWidth * mZF, .mHeight * mZF, .mAngle
    
                Case mText
                    If Len(.mText) > 0 And NewText = False Then
                    DrawControl.FillColor = .mFillColor
                    DrawControl.ForeColor = .mFillColor
                    DrawText .mText, .mLeft * mZF, .mTop * mZF, .mWidth * mZF, .mHeight * mZF, .mFontName, .mFontSize * mZF, .mAngle, .mFontBold, _
                    .mFontItalic, .mFontUnderline, .mFontStrikethru, .mTextAlign
                    End If
                Case mImage
                    If .mAspect = 1 Then
                    tRatio = .mPicture.Height / .mPicture.Width
                    .mHeight = .mWidth * tRatio
                    End If
                    If .mWidth = -1 Then
                    .mWidth = DrawControl.ScaleX(.mPicture.Width)
                    End If
                    If .mHeight = -1 Then
                    .mHeight = DrawControl.ScaleY(.mPicture.Height)
                    End If
    
                DrawPicture .mPicture, .mLeft * mZF, .mTop * mZF, .mWidth * mZF, .mHeight * mZF, .mAngle
                
                Case mPolygon
                If .mAspect = 1 Then
                .mHeight = .mWidth
                End If
                DrawControl.DrawWidth = .mBorderWidth * mZF
                DrawControl.FillColor = .mFillColor
                DrawControl.ForeColor = .mBorderColor
                DrawPolygon .mPointQty, .mLeft * mZF, .mTop * mZF, .mWidth * mZF, .mHeight * mZF, .mAngle
                
                Case mStar
                If .mAspect = 1 Then
                .mHeight = .mWidth
                End If
                DrawControl.DrawWidth = .mBorderWidth * mZF
                DrawControl.FillColor = .mFillColor
                DrawControl.ForeColor = .mBorderColor
                DrawStar .mPointQty, .mLeft * mZF, .mTop * mZF, .mWidth * mZF, .mHeight * mZF, .mAngle
            End Select
        
        End If
        End With
        Next n
    End If
    
    DrawControl.FillStyle = 1
    DrawControl.DrawWidth = 1
    DrawControl.DrawStyle = 0
    DrawControl.Font = myFont
    DrawControl.FontSize = 8
    DrawControl.FontBold = False
    DrawControl.FontItalic = False
    DrawControl.FontUnderline = False
    DrawControl.FontStrikethru = False
    
    If isDown = False And NextLine = False And NewText = False Then
        If ShowSel = True Then
        ShowSelection
        End If
    End If
End Sub

Private Function CheckSelection(selX As Single, selY As Single) As Integer
    On Error Resume Next            ' check which selection dot is clicked
    Dim tC As myCoorType
    Dim tS As Integer
    
    If ObjIndex = -1 Then
    CheckSelection = -1
    DrawControl.MousePointer = 0
    Exit Function
    End If
    
    If ObjList(ObjIndex).mGroupMember > 0 Then 'to avoid resize on grouped objects
    CheckSelection = -1
    DrawControl.MousePointer = 0
    Exit Function
    End If
    
    tC = GetSelPosition(ObjList(ObjIndex).mLeft * mZF, ObjList(ObjIndex).mTop * mZF, ObjList(ObjIndex).mWidth * mZF, ObjList(ObjIndex).mHeight * mZF, ObjList(ObjIndex).mAngle)
    
    If selX > tC.posX1 - 10 And selY > tC.posY1 - 10 And selX < tC.posX1 - 2 And selY < tC.posY1 - 2 Then
    tS = 0
    DrawControl.MousePointer = 8
    ElseIf selX > tC.posX1 + tC.CenterX - 4 And tC.posY1 - 10 And selX < tC.posX1 + tC.CenterX + 4 And selY < tC.posY1 - 2 Then
    tS = 1
    DrawControl.MousePointer = 7
    ElseIf selX > tC.posX4 + 2 And selY > tC.posY4 - 10 And selX < tC.posX4 + 10 And selY < tC.posY4 - 2 Then
    tS = 2
    DrawControl.MousePointer = 6
    ElseIf selX > tC.posX1 - 10 And selY > tC.posY1 + tC.CenterY - 4 And selX < tC.posX1 - 2 And selY < tC.posY1 + tC.CenterY + 4 Then
    tS = 3
    DrawControl.MousePointer = 9
    ElseIf selX > tC.posX4 + 2 And selY > ((tC.posY4 - tC.posY3) / 2) + tC.posY3 - 4 And selX < ((tC.posX4 - tC.posX3) / 2) + tC.posX3 + 10 And selY < ((tC.posY4 - tC.posY3) / 2) + tC.posY3 + 4 Then
    tS = 4
    DrawControl.MousePointer = 9
    ElseIf selX > tC.posX2 - 10 And selY > tC.posY2 + 2 And selX < tC.posX2 - 2 And selY < tC.posY2 + 10 Then
    tS = 5
    DrawControl.MousePointer = 6
    ElseIf selX > tC.posX1 + tC.CenterX - 4 And selY > tC.posY2 + 2 And selX < tC.posX1 + tC.CenterX + 4 And selY < tC.posY2 + 10 Then
    tS = 6
    DrawControl.MousePointer = 7
    ElseIf selX > tC.posX3 + 2 And selY > tC.posY3 + 2 And selX < tC.posX3 + 10 And selY < tC.posY3 + 10 Then
    tS = 7
    DrawControl.MousePointer = 8
    Else
    tS = -1
    End If
    
    If ObjList(ObjIndex).mWidth < 0 And ObjList(ObjIndex).mHeight < 0 And tS >= 0 Then
        Select Case tS
            Case 0: CheckSelection = 7
            Case 1: CheckSelection = 6
            Case 2: CheckSelection = 5
            Case 3: CheckSelection = 4
            Case 4: CheckSelection = 3
            Case 5: CheckSelection = 2
            Case 6: CheckSelection = 1
            Case 7: CheckSelection = 0
        End Select
    ElseIf ObjList(ObjIndex).mWidth < 0 And tS >= 0 Then
        Select Case tS
            Case 0: CheckSelection = 2
            Case 1: CheckSelection = 1
            Case 2: CheckSelection = 0
            Case 3: CheckSelection = 4
            Case 4: CheckSelection = 3
            Case 5: CheckSelection = 7
            Case 6: CheckSelection = 6
            Case 7: CheckSelection = 5
        End Select
    ElseIf ObjList(ObjIndex).mHeight < 0 And tS >= 0 Then
        Select Case tS
            Case 0: CheckSelection = 5
            Case 1: CheckSelection = 6
            Case 2: CheckSelection = 7
            Case 3: CheckSelection = 3
            Case 4: CheckSelection = 4
            Case 5: CheckSelection = 0
            Case 6: CheckSelection = 1
            Case 7: CheckSelection = 2
        End Select
    Else
    CheckSelection = tS
    End If
End Function

Public Sub ModifyObject(Optional tTop As Single = -1, Optional tLeft As Single = -1, _
    Optional tHeight As Single = -1, Optional tWidth As Single = -1, Optional tAngle As Single = -1, Optional tFillColor As Long = -1, _
    Optional tFillStyle As myFill = -1, Optional tBorderColor As Long = -1, Optional tBorderWidth As Integer = -1, Optional tPicture As StdPicture, _
    Optional tFontName As String = "", Optional tFontSize As Integer = -1, Optional tFontBold As myBool3 = Unchanged, _
    Optional tFontItalic As myBool3 = Unchanged, Optional tFontUnderline As myBool3 = Unchanged, _
    Optional tFontStrikethru As myBool3 = Unchanged, Optional tText As String = "", Optional tTextAlign As AlignmentConstants = -1, _
    Optional tPointQty As Integer = -1, Optional tPosX0 As Single = -1, Optional tPosY0 As Single = -1, _
    Optional tPosX1 As Single = -1, Optional tPosY1 As Single = -1, Optional tPosX2 As Single = -1, _
    Optional tPosY2 As Single = -1, Optional tPosX3 As Single = -1, Optional tPosY3 As Single = -1, _
    Optional tGroupMember As Integer = -1)
    
    Dim n As Long
    Dim tGr As Integer
    
    NextLine = False
    NewObj = False
    
    On Error Resume Next
    
    tGr = ObjList(ObjIndex).mGroupMember
    
    If QtySel > 0 And tGr = 0 Then
    For n = 0 To QtySel - 1
    With ObjList(ListSel(n))
        If tFillColor > -1 Then .mFillColor = tFillColor
        If tFillStyle > -1 Then .mFillStyle = tFillStyle
        If tAngle > -1 Then .mAngle = tAngle
        If .mObjectType = mArc Then .mAngle = 0
        If tBorderColor > -1 Then .mBorderColor = tBorderColor
        If tBorderWidth > -1 Then .mBorderWidth = tBorderWidth
        If tPointQty > -1 Then .mPointQty = tPointQty
        If tPosX0 > -1 Then .mPosX0 = tPosX0
        If tPosY0 > -1 Then .mPosY0 = tPosY0
        If tPosX1 > -1 Then .mPosX1 = tPosX1
        If tPosY1 > -1 Then .mPosY1 = tPosY1
        If tPosX2 > -1 Then .mPosX2 = tPosX2
        If tPosY2 > -1 Then .mPosY2 = tPosY2
        If tPosX3 > -1 Then .mPosX3 = tPosX3
        If tPosY3 > -1 Then .mPosY3 = tPosY3
        If tGroupMember > -1 Then .mGroupMember = tGroupMember
            If .mObjectType = mText Then
                If tFontName <> "" Then .mFontName = tFontName
                If tFontSize > 2 Then .mFontSize = tFontSize
                If tFontBold <> Unchanged Then .mFontBold = tFontBold
                If tFontItalic <> Unchanged Then .mFontItalic = tFon