vb绘图代码

Option Base 1
Dim bgn_line As Boolean
Dim bgn_circle As Boolean
Dim x1 As Single
Dim y1 As Single
Private Type info_line
x1 As Single
y1 As Single
x2 As Single
y2 As Single
wid As Integer
End Type
Private Type info_circle
x1 As Single
y1 As Single
r As Single
wid As Integer
End Type
Private Type info_dot
x1 As Single
y1 As Single
wid As Integer
End Type
Dim stack_cir() As info_circle
Dim stack_line() As info_line
Dim stack_dot() As info_dot
Dim top_cir As Long
Dim top_line As Long
Dim top_dot As Long
Private Sub redraw()
Dim i As Integer
If top_cir Then
For i = 1 To top_cir
pic.DrawWidth = stack_cir(i).wid
pic.Circle (stack_cir(i).x1, stack_cir(i).y1), stack_cir(i).r
Next i
pic.DrawWidth = com_width.Text
End If
If top_line Then
For i = 1 To top_line
pic.DrawWidth = stack_line(i).wid
pic.Line (stack_line(i).x1, stack_line(i).y1)-(stack_line(i).x2, stack_line(i).y2) Next i
pic.DrawWidth = com_width.Text
End If
If top_dot Then
For i = 1 To top_dot
pic.DrawWidth = stack_dot(i).wid
pic.PSet (stack_dot(i).x1, stack_dot(i).y1)
Next i
pic.DrawWidth = com_width.Text
End If
End Sub
Private Function s(x1 As Single, y1 As Single, x2 As Single, y2 As Single)
s = Sqr((x1 - x2) ^ 2 + (y1 - y2) ^ 2)
End Function
Private Sub Combo2_Change()
Picture1.DrawWidth = Int(Combo2.Text)
End Sub
Private Sub Command1_Click()
pic.Cls
top_line = 0
top_circle = 0
top_dot = 0
End Sub
Private Sub Command2_Click()
End
End Sub
Private Sub pic_MouseDown(button As Integer, shift As Integer, x As Single, y As Single) If button = 1 Then
Select Case com_style.Text
Case "直线":
If bgn_line Then
pic.Line (x1, y1)-(x, y)
ReDim Preserve stack_line(top_line + 1)
top_line = top_line + 1
stack_line(top_line).x1 = x1
stack_line(top_line).y1 = y1
stack_line(top_line).x2 = x2
stack_line(top_line).y2 = y2
stack_line(top_line).wid = pic.DrawWidth
Else
x1 = x
y1 = y
End If
bgn_line = Not bgn_line
Case "圆":
If bgn_circle Then
pic.Circle (x1, y1), s(x1, y1, x, y)
ReDim Preserve stack_cir(top_cir + 1)
top_cir = top_cir + 1
stack_cir(top_cir).r = s(x1, y1, x, y)
stack_cir(top_cir).wid = pic.DrawWidth
stack_cir(top_cir).x1 = x1
stack_cir(top_cir).y1 = y1
Else
x1 = x
y1 = y
End If
bgn_circle = Not bgn_circle
Case "点":
pic.PSet (x, y)
ReDim Preserve stack_dot(top_dot + 1)
top_dot = top_dot + 1
stack_line(top_dot).x1 = x
stack_line(top_dot).y1 = y
stack_dot(top_dot).wid = pic.DrawWidth
Case Else
End Select
End If
End Sub
Private Sub pic_mousemove(button As Integer, shift As Integer, x As Single, y As Single) Select Case com_style.Text
Case "直线":
If bgn_line Then
pic.Cls
pic.Line (x1, y1)-(x, y)
redraw
End If
Case "圆":
If bgn_circle Then
pic.Cls
pic.Circle (x1, y1), s(x1, y1, x, y)
redraw
End If
Case "点":
End Select
End Sub
Private Sub Form_Load()
Combo1.AddItem "直线"
Combo1.AddItem "圆"
Combo1.AddItem "点"
Combo1.Text = "直线"
Combo2.AddItem "1"
Combo2.AddItem "3"
Combo2.AddItem "5"
Combo2.AddItem "10"
Combo2.Text = "1"
bgn_line = False
bgn_circle = False
top_line = 0
top_cir = 0
top_dot = 0
End Sub
Private Sub Picture1_Paint()
Picture1.Cls
Picture1.ScaleHeight = 7200
Picture1.ScaleWidth = 8200
Picture1.ScaleTop = -3600
Picture1.ScaleLeft = -4100
Picture1.Line (-4100, 0)-(4100, 0)
Picture1.Line (0, -3600)-(0, 3600)
Picture1.CurrentX = 100: Picture1.CurrentY = 0: Picture1.Print "0" Picture1.CurrentX = 3900: Picture1.CurrentY = 30: Picture1.Print "x" Picture1.CurrentX = 100: Picture1.CurrentY = -3500: Picture1.Print "y" End Sub。