Wednesday, April 29, 2020

Drawing Source code in VB6.0





Dim DrawType
Dim tX, tY
Dim Start, dX, dY
Private Sub Combo1_Click()
    Picture1.DrawMode = Combo1.ListIndex + 1
End Sub


Private Sub Command1_Click()
    End
End Sub

Private Sub Command2_Click()
    Picture1.Cls
End Sub


Private Sub Command3_Click()
    If Command3.Caption = "Filled" Then
        Picture1.FillStyle = 0
        Command3.Caption = "Empty"
        Else
            Picture1.FillStyle = 1
            Command3.Caption = "Filled"
    End If
End Sub

Private Sub Form_Load()
    Combo1.ListIndex = 12
    List1.ListIndex = 0
    HScroll1_Change
    HScroll2_Change
End Sub

Private Sub HScroll1_Change()
    Shape2.Width = HScroll1.Value * 60
    Shape2.Height = HScroll1.Value * 60
    Shape2.Left = (Picture3.Width - Shape2.Width) / 2
    Shape2.Top = (Picture3.Height - Shape2.Height) / 2
    Picture1.DrawWidth = HScroll1.Value * 4
End Sub

Private Sub HScroll2_Change()
    Picture2.BackColor = QBColor(HScroll2.Value)
    Shape2.BackColor = QBColor(HScroll2.Value)
    Picture1.ForeColor = QBColor(HScroll2.Value)
End Sub

Private Sub List1_Click()
    Select Case List1.ListIndex
        Case 0
            DrawType = "Point"
        Case 1
            DrawType = "Line"
        Case 2
            DrawType = "Filled rectangle"
        Case 3
            DrawType = "Empty rectangle"
        Case 4
            DrawType = "Circle"
        Case 5
            DrawType = "Arc"
        Case 6
            DrawType = "Polygon"
            Start = True
    End Select
End Sub


Private Sub Picture1_DblClick()
    Picture1.Line (tX, tY)-(dX, dY)
    Start = True
End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Select Case DrawType
        Case "Point"
            Picture1.PSet (X, Y), Picture2.BackColor
        Case "Line"
            tX = X: tY = Y
        Case "Filled rectangle"
            tX = X: tY = Y
        Case "Empty rectangle"
            tX = X: tY = Y
        Case "Circle"
            tX = X: tY = Y
        Case "Arc"
            tX = X: tY = Y
        Case "Polygon"
            If Start = True Then
                tX = X: tY = Y
                dX = X: dY = Y
            End If
    End Select
End Sub


Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 1 Then
    Select Case DrawType
        Case "Line"
            Picture1.Line (tX, tY)-(X, Y)
    End Select
    End If
End Sub


Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim Radius, Angle1, Angle2
   
    Select Case DrawType
        Case "Filled rectangle"
            Picture1.Line (tX, tY)-(X, Y), , B
        Case "Empty rectangle"
            Picture1.Line (tX, tY)-(X, Y), , BF
        Case "Circle"
            Radius = Sqr((tX - X) ^ 2 + (tY - Y) ^ 2)
            Picture1.Circle (tX, tY), Radius
        Case "Arc"
            Radius = Sqr((tX - X) ^ 2 + (tY - Y) ^ 2)
            If Radius <> 0 Then
                Angle1 = Abs(tX - X) / Radius
                Angle2 = Abs(tY - Y) / Radius
                Angle1 = Atn(-Angle1 / Sqr(-Angle1 * Angle1 + 1)) + 2 * Atn(1)
                Angle2 = Atn(-Angle2 / Sqr(-Angle2 * Angle2 + 1)) + 2 * Atn(1)
                Picture1.Circle (tX, tY), Radius, , Sgn(X - tX) * Angle1, Sgn(Y - tY) * Angle2
            End If
        Case "Polygon"
            Start = False
            Picture1.Line (tX, tY)-(X, Y)
            tX = X: tY = Y
    End Select
End Sub






No comments:

Post a Comment