Question

急求用VB做的一个简单画图软件代码。

急求用VB做的一个简单画图软件代码。要求是在软件界面上有圆、正方形，线等简单的图形，选择画圆的画在图上先选一点为圆心，第二点为边点，线也是一样，第一点为起点，第二点是终点。

Answer 1

Dim myflag%, myjudge%, response%
'禁止改变窗体大小代码开始
Dim oldw&, oldh&

Private Sub Form_Load()
oldw = Me.Width: oldh = Me.Height
Timer1.Interval = 200
'数据初始化
myflag = 1
myjudge = 0
End Sub
Private Sub Form_Resize()
Me.Width = oldw: Me.Height = oldh
End Sub
'禁止改变窗体大小代码结束

'运算符设置
Private Sub Command0_Click(index As Integer)
If index = 0 Then
Text4.Text = "+"
ElseIf index = 1 Then
Text4.Text = "-"
ElseIf index = 2 Then
Text4.Text = "×"
ElseIf index = 3 Then
Text4.Text = "/"
ElseIf index = 4 Then
Text4.Text = "√"
Text5.Text = ""
Text1.Text = ""
ElseIf index = 5 Then
Text4.Text = "^"
ElseIf index = 6 Then
Text4.Text = "Mod"
End If
myflag = -1
End Sub
'数值键命令
Private Sub Command1_Click(index As Integer)
If myjudge = 1 Then
Text1.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
End If
If myflag > 0 Then
Text3.Text = CStr(Text3.Text) & CStr(index)
myjudge = 2
Text1.Text = ""
Text4.Text = ""
Text5.Text = ""
ElseIf myflag < 0 Then
Text5.Text = CStr(Text5.Text) & CStr(index)
If Text4.Text = "/" And Val(Text5.Text) = 0 Then
response = MsgBox("分母不能为零！", vbOKOnly + vbExclamation + vbDefaultButton1, "注意！")
Text5.Text = ""
ElseIf Text4.Text = "Mod" And Val(Text5.Text) = 0 Then
response = MsgBox("分母不能为零！", vbOKOnly + vbExclamation + vbDefaultButton1, "注意！")
Text5.Text = ""
End If
End If
End Sub
Private Sub Command3_Click()
If myflag > 0 Then
Text3.Text = CStr(Text3.Text) & "."
End If
If myflag < 0 Then
Text5.Text = CStr(Text5.Text) & "."
End If
End Sub
'计算代码
Private Sub myjs()
If Text4.Text = "+" Then
If Val(Text3.Text) + Val(Text5.Text) < 1 And Val(Text3.Text) + Val(Text5.Text) > 0 Then
Text1.Text = CStr(Val(Text3.Text) + Val(Text5.Text))
Else
Text1.Text = Val(CStr(Val(Text3.Text) + Val(Text5.Text)))
End If
ElseIf Text4.Text = "-" Then
If Val(Text3.Text) - Val(Text5.Text) < 1 And Val(Text3.Text) - Val(Text5.Text) > 0 Then
Text1.Text = CStr(Val(Text3.Text) - Val(Text5.Text))
Else
Text1.Text = Val(CStr(Val(Text3.Text) - Val(Text5.Text)))
End If
ElseIf Text4.Text = "×" Then
If Val(Text3.Text) * Val(Text5.Text) < 1 And Val(Text3.Text) * Val(Text5.Text) > 0 Then
Text1.Text = CStr(Val(Text3.Text) * Val(Text5.Text))
Else
Text1.Text = Val(CStr(Val(Text3.Text) * Val(Text5.Text)))
End If
ElseIf Text4.Text = "/" Then
If Val(Text3.Text) / Val(Text5.Text) < 1 And Val(Text3.Text) / Val(Text5.Text) > 0 Then
Text1.Text = CStr(Val(Text3.Text) / Val(Text5.Text))
Else
Text1.Text = Val(CStr(Val(Text3.Text) / Val(Text5.Text)))
End If
ElseIf Text4.Text = "Mod" Then
If Val(Text3.Text) Mod Val(Text5.Text) < 1 And Val(Text3.Text) Mod Val(Text5.Text) > 0 Then
Text1.Text = CStr(Val(Text3.Text) Mod Val(Text5.Text))
Else
Text1.Text = Val(CStr(Val(Text3.Text) Mod Val(Text5.Text)))
End If
ElseIf Text4.Text = "^" Then
If Val(Text3.Text) ^ Val(Text5.Text) < 1 And Val(Text3.Text) ^ Val(Text5.Text) > 0 Then
Text1.Text = CStr(Val(Text3.Text) ^ Val(Text5.Text))
Else
Text1.Text = Val(CStr(Val(Text3.Text) ^ Val(Text5.Text)))
End If
ElseIf Text4.Text = "√" Then
If Val(Text3.Text) ^ 0.5 < 1 And Val(Text3.Text) ^ 0.5 > 0 Then
Text1.Text = CStr(Val(Text3.Text) ^ 0.5)
Else
Text1.Text = Val(Text3.Text) ^ 0.5
End If
End If
End Sub
'求值
Private Sub Label3_Click()
Call myjs
myflag = 1
myjudge = 1
End Sub
Private Sub Text3_GotFocus()
Text3.ToolTipText = Text3.Text
End Sub
Private Sub Text5_GotFocus()
Text5.ToolTipText = Text5.Text
End Sub
Private Sub Text1_GotFocus()
Text1.ToolTipText = Text1.Text
End Sub

Answer 2

'以下代码为纯原创. 请粘贴到新工程代码窗口后直接运行, 不需添加任何控件~

Option Explicit

Private Enum ListConstants
直线
矩形
正方形
外接式椭圆
外接式正圆
半径式正圆
End Enum

Private WithEvents List As ListBox
Private WithEvents Pic As PictureBox
Private Mode As ListConstants, X1 As Long, Y1 As Long, X2 As Long, Y2 As Long

Private Sub Form_Load()

Me.ScaleMode = vbPixels '设置窗体坐标单位
App.Title = "简易画图" '设置工程名
Me.BorderStyle = 3 '设置窗体边框样式
Me.Caption = App.Title '设置窗体标题
Set Me.Icon = Nothing '清除窗体图标
'移动窗体
Me.Move (Screen.Width - 12000) / 2, (Screen.Height - 8100) / 2, 12000, 8100

'初始化ListBox
Set List = Me.Controls.Add("VB.ListBox", "List")
List.Move 8, 8, 100, 120
List.TabStop = False
List.Visible = True
'加载Item
Dim s() As String, i As Long
s = Split("直线 矩形 正方形 外接式椭圆 外接式正圆 半径式正圆")
For i = 0 To UBound(s): List.AddItem s(i): Next
List.ListIndex = 0

'初始化PictureBox
Set Pic = Me.Controls.Add("VB.PictureBox", "Pic")
With Pic
.Move 8, 120, Me.ScaleWidth - 24, Me.ScaleHeight - 144
.MousePointer = vbCrosshair
.BackColor = vbWhite
.AutoRedraw = True
.ScaleMode = vbPixels
.Visible = True
End With
End Sub

Private Sub List_Click()
Mode = List.ListIndex: Me.Caption = App.Title & " - " & List.List(Mode)
End Sub

Private Sub Pic_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then Pic.DrawMode = vbNotXorPen: X1 = X: Y1 = Y: X2 = X: Y2 = Y: Draw
End Sub

Private Sub Pic_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then Draw: X2 = X: Y2 = Y: Draw
End Sub

Private Sub Pic_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then Draw: X2 = X: Y2 = Y: Pic.DrawMode = vbCopyPen: Draw
End Sub

Private Sub Draw()
Dim i As Long, j As Long, k As Long
Select Case Mode
Case 直线: Pic.Line (X1, Y1)-(X2, Y2)
Case 矩形: Pic.Line (X1, Y1)-(X2, Y2), , B
Case 正方形
i = X2 - X1: j = Y2 - Y1: k = Abs(IIf(Abs(i) < Abs(j), i, j))
Pic.Line (X1, Y1)-Step(k * Sgn(i), k * Sgn(j)), , B
Case 外接式椭圆
i = X2 - X1: j = Y2 - Y1
If i * j <> 0 Then
Pic.Circle (X1 + i / 2, Y1 + j / 2), Abs(IIf(Abs(i) > Abs(j), i, j)) / 2, , , , Abs(j) / Abs(i)
Else
Pic.Line (X1, Y1)-(X2, Y2)
End If
Case 外接式正圆
i = X2 - X1: j = Y2 - Y1: k = Abs(IIf(Abs(i) < Abs(j), i, j)) / 2
Pic.Circle (X1 + k * Sgn(i), Y1 + k * Sgn(j)), k
Case 半径式正圆
Pic.Circle (X1, Y1), Sqr((X1 - X2) ^ 2 + (Y1 - Y2) ^ 2)
End Select
End Sub