Question

想在用VB编的画图程序上加上画圆和矩形，该怎么改

Dim i As Boolean

Private Sub Command3_Click()
Dim a As String
a = Combo1
DrawWidth = a
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
i = True
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Not i Then
Me.CurrentX = X
Me.CurrentY = Y
Else
Me.Line -(X, Y)
End If
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
i = False
End Sub
Private Sub Command1_Click()
Me.Cls
End Sub

Private Sub Command2_Click()
Unload Me
End Sub

Private Sub Form_Load()
Me.Command1.Caption = "清除"
Me.Command2.Caption = "退出"
Combo1.AddItem "1"
Combo1.AddItem "2"
Combo1.AddItem "3"
Combo1.AddItem "4"
End Sub
这是我现在的程序代码 想在这个基础上再画圆和矩形之类的 代码应该怎么写呢？
希望大家说详细点。。 我还是新手
在我源代码的基础上 我想加个picturebox 。在picturebox中 画图 代码应该怎么改？

Answer 1

Dim PenStyle As Integer

Dim DW As Integer, bChangeDrawWidth As Boolean

Dim C(0 To 2) As Integer, bChangeRGB As Boolean

Dim Bn As Integer, oX As Single, oY As Single

Private Sub Form_Load()

  PenStyle = 0: DW = 1

  

  With Combo1

    .AddItem 1: .AddItem 2: .AddItem 3: .AddItem 4: .AddItem 5

  End With

End Sub

Private Sub CmdCls_Click()

  Picture1.Cls

End Sub

Private Sub CmdExit_Click()

  Unload Me

End Sub

Private Sub Combo1_Click()

  bChangeDrawWidth = True

End Sub

Private Sub Combo1_Change()

  bChangeDrawWidth = True

End Sub

Private Sub Combo1_KeyPress(KeyAscii As Integer)

  Select Case KeyAscii

    Case 8, 13

    Case 48 To 57

    Case Else

      KeyAscii = 0

  End Select

End Sub

Private Sub Combo1_LostFocus()

  If bChangeDrawWidth Then bChangeDrawWidth = False: DW = Val(Combo1.Text): Picture1.DrawWidth = DW

End Sub

Private Sub OptionPenStyle_Click(Index As Integer)

  If OptionPenStyle(Index).Value Then

    PenStyle = Index

    Select Case Index

      Case 0, 1, 2, 4

        Picture1.FillStyle = 0

      Case 3, 5

        Picture1.FillStyle = 1

    End Select

  End If

End Sub

Private Sub TxtRGB_Change(Index As Integer)

  bChangeRGB = True

End Sub

Private Sub TxtRGB_KeyPress(Index As Integer, KeyAscii As Integer)

  Select Case KeyAscii

    Case 8, 13

    Case 48 To 57

    Case Else

      KeyAscii = 0

  End Select

End Sub

Private Sub TxtRGB_LostFocus(Index As Integer)

  If bChangeRGB Then

    bChangeRGB = False: C(Index) = Val(TxtRGB(Index))

    If C(Index) > 255 Then C(Index) = 255: TxtRGB(Index) = "255"

    Picture1.ForeColor = RGB(C(0), C(1), C(2)): Picture1.FillColor = Picture1.ForeColor

  End If

End Sub

Private Sub Picture1_DblClick()

  Call Picture1_MouseDown(Bn, 0, oX, oY)

End Sub

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

  Bn = Button: oX = X: oY = Y

  If Bn = 1 Then

    If PenStyle = 0 Then

      Picture1.AutoRedraw = True

    Else

      Picture1.AutoRedraw = False

    End If

  End If

End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

  If Button = 1 Then

    Select Case PenStyle

      Case 0

        Picture1.Line (oX, oY)-(X, Y)

        oX = X: oY = Y

      Case 1

        Picture1.Refresh

        Picture1.Line (oX, oY)-(X, Y)

      Case 2

        Picture1.Refresh

        Picture1.Line (oX, oY)-(X, Y), , BF

      Case 3

        Picture1.Refresh

        Picture1.Line (oX, oY)-(X, Y), , B

      Case 4, 5

        Picture1.Refresh

        If X - oX <> 0 Then Picture1.Circle ((oX + X) / 2, (oY + Y) / 2), IIf(Abs(oX - X) > Abs(oY - Y), Abs(oX - X), Abs(oY - Y)) / 2, , , , Abs((Y - oY) / (X - oX))

    End Select

  End If

End Sub

Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

  If Bn = 1 Then

    Picture1.AutoRedraw = True

    Call Picture1_MouseMove(Bn, 0, X, Y)

    oX = X: oY = Y

  End If

End Sub

Answer 2

KL1112 的回答完全正确，厉害！
你补充的想添加一个图片框，我不知你是什么时候提交的。现在还需要吗？
是不是说想要两个框实现相同的功能？

如果你是这意思，目前我有三种办法
1 直接复制所有picture事件的代码，把picture1改为picture2.这方法最麻烦
2 picture控件数组