用VB编写画图程序

用VB编写画图程序,第1张

提供一个绘制任意曲线的简单代码。其他功能类似,希望能举一反三。

窗体中添加一个Picture box,然后输入命令如下:

Dim oldx As Single

Dim oldy As Single

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

    If Button = 1 Then       '当鼠标左建按下时发生

        Picture1.Line (oldx, oldy)-(X, Y)

        oldx = X

        oldy = Y

    End If

End Sub

  

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

    oldx = X

    oldy = Y

End Sub

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

0分…………

那就只告诉你函数

line(x,y)-(x,y) '线起点到终点最好用timer控制这个

pset(x,y) '画点

me.cls '清屏

其实可以load出shape控件再赋值大小


欢迎分享,转载请注明来源:内存溢出

原文地址: http://outofmemory.cn/yw/7827275.html

(0)
打赏 微信扫一扫 微信扫一扫 支付宝扫一扫 支付宝扫一扫
上一篇 2023-04-10
下一篇 2023-04-10

发表评论

登录后才能评论

评论列表(0条)

保存